home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir40 / pc37042.zip / UTIL / SEE.ALC < prev    next >
Text File  |  1988-01-03  |  101KB  |  3,227 lines
  1.     TITLE 'SEE.ALC - PC/370 SCREEN EDITOR AND EMULATOR'
  2. *
  3. * AUTHOR.    Don Higgins.
  4. *
  5. * DATE.      04/06/86.
  6. *
  7. * REMARKS.   PC/370 screen editor and emulator.
  8. *
  9. * COPYRIGHT. Copyright (c) 1988 Donald S. Higgins.
  10. *
  11. *            This source program and its derivative object and
  12. *            machine code programs may be freely copied and
  13. *            distributed provided this copyright message in the
  14. *            source program and in the object program help screen
  15. *            is not removed or modified, and that no fee is charged.
  16. *            The remainder of the program may be modified as you see
  17. *            fit to customize it to your specific needs.  If you send
  18. *            me useful enhancements, I will include them in the next
  19. *            release of PC/370 with appropriate credits.  If you find
  20. *            PC/370 of value, support continued updates by registering
  21. *            as a PC/370 user.
  22. *
  23. *            Don Higgins
  24. *            6365 - 32 Avenue North
  25. *            St. Petersburg, Florida 33710
  26. *
  27. * MAINTENANCE
  28. *
  29. *   07/19/86 DSH TESTING OF SEE R1.0 VERSION COMPLETED AND READY FOR SHIP WITH
  30. *                RELEASE R1.2 OF PC/370.
  31. *   09/11/86 DSH SEE RELEASE 1.1
  32. *                 1.  ADD BOX MODE LOGIC TO CONNECT SINGLE AND DOUBLE LINES AT
  33. *                     INTERSECTIONS.
  34. *                 2.  MODIFY F1 SCREEN FOR FPC HELP # FOR INTERNAL USE.
  35. *                 3.  SET FILE DEFAULT TO TEST.ALC INSTEAD OF BLANK NAME.
  36. *   09/16/86 DSH SEE RELEASE 1.2
  37. *                 1.  ADD ALT-F10 BOX CONNECT MODE TOGGLE KEY.
  38. *   09/19/86 DSH SEE RELEASE 1.3
  39. *                 1.  FIX SINGLE LINE CROSSING VERTICAL DOUBLE LT TO RT.
  40. *   04/28/87 DSH SEE RELEASE 1.4
  41. *                 1.  FIX SEARCH AND REPLACE TO SET FILEMOD IF MATCH.
  42. *                 2.  STARTUP IN INSERT MODE FOR NEW FILE.
  43. *                 3.  ALLOW 132 BYTE INPUT RECORDS TRUNCATED TO 80.
  44. *   04/29/87 DSH SEE RELEASE 2.0
  45. *                 1.  CONVERT TO PC/370 RELEASE 2.0 WITH NEW FILE PATHING
  46. *                     I/O SUPPORT WITH NEW DCB.
  47. *                 2.  USE GETMAIN/FREEMAIN IN VIRTUAL ADDRESS SPACE INSTEAD
  48. *                     OF CROSS MEMORY MVCP/MVCS.
  49. *   05/21/87 DSH - UPDATE SOURCE AND HELP SCREEN MESSAGES
  50. *
  51. *   07/12/87 DSH SEE RELEASE 2.1
  52. *             1.  SUPPORT TABS FOR COL. 10, 16, AND 5 BLKS IN TEXT
  53. *             2.  UPDATE FROM SCREEN BEFORE F8 SEARCH STARTS
  54. *   01/03/88 DSH SEE RELEASE 2.2
  55. *             1.  USE STANDARD EBCDIC PARM LIST AT X'80'
  56. *
  57. *  INPUT
  58. *
  59. *  1.  A>SEE file1 file2
  60. *
  61. *      file1 - Name of new or existing ASCII text file to edit.
  62. *              Maximum size is about 512k with 640k memory.
  63. *              The default suffix is ALC.
  64. *
  65. *      file2 - Optional name of new or existing keyboard simulator file.
  66. *              The default suffix is KSF.  If the file is new all keystrokes
  67. *              entered during the current edit session will be recorded in
  68. *              the file.  If the file is old, the entire edit session will
  69. *              be simulated using the keystrokes in the file.  This feature
  70. *              is used to run validation tests on the editor.  It can also
  71. *              be used to create animated displays for demonstrations.
  72. *
  73. * OUTPUT
  74. *
  75. *  1.  Input file1 will be replaced with new file with changes.
  76. *  2.  Old file1 will be renamed with suffix of (.BAK).
  77. *  3.  Keyboard controls are designed to be compatible with
  78. *      both TURBO PASCAL and PFS:WRITE.  For definitions see
  79. *      F1 and F2 help screen text in data section of program.
  80. *      (you can search via (F7) for label F1SC and F2SC)
  81. *
  82. *
  83. SEE      CSECT
  84.     USING *,R15
  85.     STM   R14,R12,12(R13)
  86.     BAL   R15,START
  87.     DROP  R15
  88.     DC    18F'0'
  89. START    EQU   *
  90.     ST    R13,4(R15)
  91.     ST    R15,8(R13)
  92.     LR    R13,R15
  93.     USING SEE+8,R13
  94.     LA    R8,2048(R13)
  95.     LA    R8,2048(R8)
  96.     USING SEE+8+4096,R8
  97.     LA    R9,2048(R8)
  98.     LA    R9,2048(R9)
  99.     USING SEE+8+4096+4096,R9
  100.     LA    R10,2048(R9)
  101.     LA    R10,2048(R10)
  102.     USING SEE+8+4096+4096+4096,R10
  103.     BAL   R14,GETPARM     PROCESS PARM FILE NAMES
  104.     LTR   R15,R15
  105.     BNZ   SEEEND
  106.     BAL   R14,INIT        INITIALIZE SCREEN AND POINTERS
  107.     LTR   R15,R15
  108.     BNZ   SEEEND
  109.     BAL   R14,LOADFILE    LOAD FILE INTO EXTENDED STORAGE
  110.     CLI   EOJ,TRUE
  111.     BE    SEEEND
  112.     BAL   R14,EDITFILE    EDIT FILE IN FULL SCREEN MODE
  113.     BAL   R14,SAVEFILE    SAVE FILE IF MODIFIED
  114.     BAL   R14,TERMKSF     TERMINATE KSF IF ACTIVE
  115. SEEEND   EQU   *
  116.     LA    R0,X'0003'     AH=0,AL=2 FOR 25X80 COLOR MODE
  117.     SVC   VIDEO          SET MODE AND CLEAR SCREEN (TECH. A-48)
  118.     LA    R0,X'0200'     AH=2 SET CURSOR
  119.     LA    R1,0           BH=0 PAGE
  120.     LA    R15,X'0000'    DH=ROW,DL=COL
  121.     SVC   VIDEO          SET CURSOR TO UPPER LEFT CORNER
  122.     LA    R0,X'0920'     AH=10, AL=SPACE
  123.     LA    R1,X'0000'     BH=0 PAGE,BL=ATTRIB.
  124.     LA    R1,X'07'       CLEAR SCREEN WITH BLACK ON WHITE
  125.     LA    R14,25*80      CHARACTERS ON DATA LINES
  126.     SVC   VIDEO          CLEAR DATA LINES
  127.     LA    R0,X'0B00'
  128.     SR    R1,R1
  129.     SVC   VIDEO           RESET BACKGROUND TO MS-DOS BLACK
  130.     SVC   EXIT            EXIT TO MS-DOS
  131.     TITLE 'GETPARM - MOVE PARM TO DCB'
  132. GETPARM  EQU   *
  133.     TM    0(R1),X'80'     VERIFY STD. OS/VS SINGLE ADDR. PARM
  134.     BZ    GETPERR
  135.     L     R1,0(R1)        USE STD OS/VS PARM - DSH 01/03/88
  136.     LH    R4,0(R1)
  137. GETDSN1  EQU   *
  138.     LA    R3,2(R1)        R3 = ADDRESS COMMAND PATH/FILENAME
  139.     CH    R4,=H'1'
  140.     BL    GETDSN2         USE DEFAULT IF NO FILENAME
  141.     LA    R5,DSN1         R5 = SYSUT1 PATH/FILENAME
  142.     SR    R6,R6           R6 = ADDR OF SUFFIX . IF ANY
  143. SKPLSP1  EQU   *               SKIP LEADING SPACES
  144.     CLI   0(R3),C' '
  145.     BNE   MVCDSN1
  146.     LA    R3,1(R3)
  147.     BCT   R4,SKPLSP1
  148.     B     KSDONE          USE DEFAULT IF ALL BLANKS
  149. MVCDSN1  EQU   *
  150.     CLI   0(R3),C' '      IF SPACE, CHK SUFFIX
  151.     BE    CHKALC
  152.     MVC   0(1,R5),0(R3)
  153.     CLI   0(R5),C'.'
  154.     BNE   SKPPD1
  155.     LR    R6,R5
  156.     ST    R6,ATYPE1      SAVE ADDRESS OF .XXX IN DSN1
  157. SKPPD1   EQU   *
  158.     LA    R5,1(R5)
  159. SKPBLK1  LA    R3,1(R3)
  160.     BCT   R4,MVCDSN1
  161. CHKALC   EQU   *
  162.     MVI   0(R5),X'00'    ADD ZERO BYTE
  163.     LTR   R6,R6
  164.     BZ    ADDALC
  165.     CLC   0(4,R6),=C'.ALC'
  166.     BE    GETDSN2
  167.     MVI   ALC,FALSE
  168.     B     GETDSN2
  169. ADDALC   EQU   *
  170.     ST    R5,ATYPE1      SAVE ADDRESS OF .ALC ADDED TO DSN1
  171.     MVC   0(4,R5),=C'.ALC'
  172.     MVI   4(R5),X'00'    ADD ZERO BYTE
  173. *
  174. *  PROCESS SECOND FILE PARM IF PRESENT AS KEYBOARD SIMULATOR FILE
  175. *
  176. GETDSN2  EQU   *
  177.     CH    R4,=H'1'
  178.     BL    KSDONE     IF NO SECOND FILE, EXIT NOW
  179.     LA    R5,DSN2         R5 = SYSUT2 PATH/FILENAME
  180.     SR    R6,R6           R6 = ADDR OF SUFFIX . IF ANY
  181. MVCDSN2  EQU   *
  182.     CLI   0(R3),C' '      IF SPACE, CHK SUFFIX
  183.     BE    SKPBLK2
  184.     MVC   0(1,R5),0(R3)
  185.     CLI   0(R5),C'.'
  186.     BNE   SKPPD2
  187.     LR    R6,R5
  188. SKPPD2   EQU   *
  189.     LA    R5,1(R5)
  190. SKPBLK2  LA    R3,1(R3)
  191.     BCT   R4,MVCDSN2
  192. CHKKSF   EQU   *
  193.     MVI   0(R5),X'00'    ADD ZERO BYTE
  194.     LTR   R6,R6
  195.     BNZ   SKPTYP2
  196. ADDKSF   EQU   *
  197.     MVC   0(4,R5),=C'.KSF'
  198.     MVI   4(R5),X'00'    ADD ZERO BYTE
  199. SKPTYP2  EQU   *
  200.     MVI   KSMODE,KSREAD   ASSUME READ MODE
  201.     LA    R2,SYSUT2
  202.     USING IHADCB,R2
  203.     SVC   SEARCH
  204.     CLM   R0,1,=X'00'
  205.     BE    KSOPEN
  206.     MVI   KSMODE,KSWRITE   IF NOT FOUND, SET WRITE MODE
  207.     MVC   KSNEXT,=A(KSREC) RESET POINTER FOR WRITE
  208.     MVI   MACRF,C'P'       RESET DCB TO PUT
  209.     DROP  R2
  210. KSOPEN   EQU   *
  211. *******  MVI   AUDIT,TRUE       SET DEFAULT AUDIT MODE FOR EMULATION
  212.     LA    R2,SYSUT2
  213.     SVC   OPEN
  214. KSDONE   EQU   *
  215.     CLI   KSMODE,KSREAD
  216.     BE    KSSKPOFF
  217.     SVC   TRACE
  218.     DC    C'IOF '          TURN KEYBOARD INTERRUPTS OFF
  219. KSSKPOFF EQU   *
  220.     SR    R15,R15
  221.     BR    R14
  222. GETPERR  EQU   *                 INVALID PARM ERROR
  223.     LA    R2,=C'INVALID PARM LIST$'
  224.     SVC   WTO
  225.     LA    R15,16
  226.     BR    R14
  227.     TITLE 'INIT - INITIALIZE SCREEN AND POINTERS'
  228. INIT     EQU   *
  229.     ST    R14,INITSV14
  230.     LA    R0,X'0003'     AH=0,AL=2 FOR 25X80 COLOR MODE
  231.     SVC   VIDEO          SET MODE AND CLEAR SCREEN (TECH. A-48)
  232.     LA    R0,X'0200'  AH=2 SET CURSOR
  233.     LA    R1,0        BH=0 PAGE
  234.     LA    R15,X'0000' DH=ROW,DL=COL
  235.     SVC   VIDEO       SET CURSOR TO UPPER LEFT CORNER
  236.     LA    R0,X'0920'  AH=10, AL=SPACE
  237.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  238.     IC    R1,ATTRIB
  239.     LA    R14,25*80   CHARACTERS ON DATA LINES
  240.     SVC   VIDEO       CLEAR DATA LINES
  241.     LA    R0,X'0B00'     AH=11 FOR SET COLOR PALETTE (TECH. A-49)
  242.     SR    R1,R1
  243.     IC    R1,ATTRIB
  244.     SRL   R1,4
  245.     N     R1,=X'00000007' TURN OFF BLINK BIT
  246.     SVC   VIDEO           SET BACKGROUND COLOR TO SAME AS ATTRIB
  247.     L     R1,=X'00FFFFFF'
  248.     SVC   GETMAIN
  249.     CLM   R0,1,=X'00'
  250.     BE    E02            VERIFY MAX. MEMORY SET IN R1
  251.     SH    R1,=AL2(LBUFFS) REDUCE ALLOCATED MEMORY FOR BUFFERS
  252.     BNP   E02
  253.     SVC   GETMAIN        ALLOCATE IT
  254.     ST    R2,ASCB        ALLOCATE AREA FOR SCREEN
  255.     SH    R1,=AL2(24*LSCB) REDUCE ALLOCATED BY SCB'S
  256.     BNP   E02
  257.     AH    R2,=AL2(23*LSCB)
  258.     ST    R2,MAXSCB      ADDR OF LAST SCB
  259.     AH    R2,=AL2(LSCB)  UPDATE R2 TO START TO TEXT AREA
  260.     ST    R1,GFQEL       SET LENGTH OF EXTENDED STORAGE
  261.     ST    R2,GFQEA       SET ADDRESS
  262.     ST    R2,MINMEM      SAVE LOW LIMIT
  263.     AR    R2,R1
  264.     ST    R2,MAXMEM      SAVE MAX LIMIT
  265.     SR    R0,R0
  266.     D     R0,=A(LLB)
  267.     ST    R1,FMAXLINE    SET MAX LINES POSSIBLE
  268.     LA    R1,F1SC
  269.     LA    R2,F1SCEND-F1SC
  270.     SVC   EBCASC
  271.     L     R1,=A(F2SC)
  272.     LA    R2,F2SCEND-F2SC
  273.     SVC   EBCASC
  274.     L     R14,INITSV14
  275.     BR    R14
  276.     TITLE 'LOADFILE - READ FILE INTO LB CHAIN IN EXTENDED MEMORY'
  277. LOADFILE EQU   *
  278.     ST    R14,LOADSV14
  279.     MVI   EOF1,FALSE
  280.     MVC   STATNAME,DSN1    MOVE DSN TO STATUS LINE
  281.     LA    R3,STATLINE
  282.     LA    R4,L'STATLINE
  283.     BAL   R14,PUTSTAT      PRINT ENTIRE STATUS LINE ONCE
  284.     BAL   R14,KEYSTATS
  285.     BAL   R14,CLEAR
  286.     LA    R2,F1SC
  287.     L     R3,=A(F1SCEND)
  288.     BAL   R14,HELPSCRN
  289.     LA    R2,SYSUT1
  290.     SVC   SEARCH
  291.     CLM   R0,1,=X'00'  DOES FILE EXIST
  292.     BNE   NULLFILE     NO, GO BUILD NEW FILE
  293.     LA    R2,SYSUT1
  294.     SVC   OPEN
  295.     MVC   WLBPREV,=A(0)
  296.     L     R12,MINMEM
  297.     USING LB,R12
  298.     ST    R12,GLBFIRST
  299.     LA    R5,100
  300. LOADLOOP EQU   *
  301.     LA    R3,LLB(R12)
  302.     ST    R3,WLBNEXT
  303.     CL    R3,MAXMEM            VERIFY NOT OUT OF MEMORY
  304.     BNL   LOADERR
  305.     LA    R1,WLBLINE
  306.     LA    R2,SYSUT1
  307.     SVC   GET                  READ RECORD INTO LB
  308.     LA    R1,WLBLINE
  309. LOADTABS EQU   *                    EXPAND TABS
  310.     TRT   0(80,R1),FINDTAB     FIND TAB OR EOR
  311.     BZ    LOADSKPT             EXIT IF NONE
  312.     CLM   R2,1,=AL1(ASCLF)     IS IT EOR
  313.     BE    LOADSKPT             EXIT IF EOR
  314.     MVC   SAVETEXT,1(R1)       SAVE REMAINING TEXT AFTER TAB
  315.     MVC   0(9,R1),=9AL1(ASCBLK)  INSERT MAX BLANKS
  316.     CL    R1,=A(WLBLINE+9)       IS THIS TAB TO COL. 10
  317.     BNL   LOADCK16
  318.     LA    R1,WLBLINE+9           YES, SKIP TO COL. 10
  319.     B     LOADREM
  320. LOADCK16 EQU   *
  321.     CL    R1,=A(WLBLINE+15)     IS THIS TAB TO COL. 16
  322.     BNL   LOADSKP5
  323.     LA    R1,WLBLINE+15         YES, SKIP TO COL. 16
  324.     B     LOADREM
  325. LOADSKP5 EQU   *                     NO, SKIP 5 COLUMNS
  326.     LA    R1,5(R1)
  327. LOADREM  EQU   *
  328.     MVC   0(80,R1),SAVETEXT     CONCATENATE REMAINING TEXT
  329.     B     LOADTABS              CONTINUE SCAN FOR TABS
  330. LOADSKPT EQU   *
  331.     MVC   LB(LLB),WLB   MOVE LB TO MEMORY
  332.     ST    R12,WLBPREV
  333.     LR    R12,R3
  334.     BCT   R5,LOADLOOP
  335.     AP    PTOTAL,=P'100'
  336.     MVC   STATREC,=X'402020202020'
  337.     ED    STATREC,PTOTAL
  338.     LA    R3,STATREC
  339.     LA    R4,L'STATREC
  340.     BAL   R14,PUTSTAT
  341.     ZAP   PLSTLINE,PTOTAL
  342.     BAL   R14,PUTPCT
  343.     LA    R1,WLBLINE
  344.     LA    R2,SYSUT1
  345.     LA    R5,100
  346.     B     LOADLOOP
  347. NULLFILE EQU   *
  348.     MVI   KBINS,INSSTATE  START IN INSERT FOR NEW FILE
  349.     BAL   R14,NEWFILE
  350.     LA    R1,=CL20'NEW FILE'
  351.     BAL   R14,PUTMSG
  352.     B     LOADSKPC
  353. LOADERR  EQU   *
  354.     MVI   EOJ,TRUE         SHUT DOWN IF LOAD ERR
  355.     LA    R1,=CL20'* OUT OF MEMORY *'
  356.     BAL   R14,PUTMSG
  357.     BAL   R14,GETKEY
  358.     B     LOADSKPC
  359. EOFUT1   EQU   *                NORMAL END OF FILE ON INPUT
  360.     CVD   R5,PWORK
  361.     ZAP   PLSTLINE,=P'100'
  362.     SP    PLSTLINE,PWORK
  363.     AP    PLSTLINE,PTOTAL  CALC TOTAL LINES LOADED
  364.     L     R12,WLBPREV
  365.     MVC   LBNEXT,=A(0) RESET NEXT IN LAST LB
  366.     ST    R12,GLBLAST
  367.     ST    R3,GFQEA         UPDATE FREE MEMORY START
  368.     L     R4,MAXMEM
  369.     SR    R4,R3
  370.     ST    R4,GFQEL         UPDATE REMAINING FREE LENGTH
  371.     ZAP   PCUR,=P'1'
  372.     MVC   GLBCUR,GLBFIRST  RESET TO FIRST LB
  373.     LA    R2,SYSUT1
  374.     SVC   CLOSE
  375.     BAL   R14,PUTPCT
  376. LOADSKPC EQU   *
  377.     BAL   R14,AUDITMS
  378.     L     R14,LOADSV14
  379.     BR    R14
  380.     TITLE 'EDITFILE ENTER FULL SCREEN MODE TO BROWZE/CHANGE FILE'
  381. EDITFILE EQU   *
  382.     ST    R14,EDITSV14
  383.     LA    R1,=CL20'EDIT'
  384.     BAL   R14,PUTMSG
  385.     BAL   R14,DISPLAY    DISPLAY 24 LINES PLUS STATUS
  386. EDITLOOP EQU   *
  387.     BAL   R14,GETKEY      GET NEXT KEY INPUT
  388.     SR    R2,R2           CLEAR FUNCTION CODE REG.
  389.     TRT   KEY,KEYTAB
  390.     L     R0,WAITLOOP     LOOP ON BCT FOR COUNT IN WAITLOOP
  391.     BCT   R0,*
  392.     L     R15,KRTAB(R2)
  393.     BALR  R14,R15         PROCESS KEY
  394.     BAL   R14,AUDITSCB    AUDIT SCB'S IF AUDIT ON
  395.     CLI   EOJ,TRUE        IS IT END OF JOB (ESCAPE KEY)
  396.     BNE   EDITLOOP
  397.     L     R14,EDITSV14
  398.     BR    R14
  399.     TITLE 'SAVEFILE RENAME OLD FILE AND WRITE NEW FILE IF CHANGED'
  400. SAVEFILE EQU   *
  401.     ST    R14,SAVESV14
  402.     ST    R5,SAVEROW
  403.     ST    R6,SAVECOL
  404.     ST    R7,SAVESCB
  405.     LA    R1,=CL20'SAVING'
  406.     BAL   R14,PUTMSG
  407.     BAL   R14,UPDATE    UPDATE FILE WITH ANY CHANGES ON SCREEN
  408.     CLI   FILEMOD,TRUE  HAS FILE CHANGED
  409.     BNE   SAVESKIP      NO, EXIT NOW
  410.     MVI   EOF1,FALSE
  411.     MVI   SYSUT1+(MACRF-IHADCB),C'P'  CHANGE DCB FROM GET TO PUT
  412.     CLI   FIRSTSAV,TRUE
  413.     BNE   SAVESKPR       IF NOT FIRST SAVE, SKIP RENAME
  414.     MVI   FIRSTSAV,FALSE
  415.     LA    R2,SYSUT1
  416.     USING IHADCB,R2
  417.     SVC   SEARCH
  418.     CLM   R0,1,=X'00'
  419.     BNE   SAVESKPR       IF NO OLD FILE, SKIP
  420.     L     R1,ATYPE1
  421.     MVC   SAVETYPE,1(R1) SAVE ORIG. TYPE
  422.     MVC   1(3,R1),=C'BAK'
  423.     SVC   SEARCH
  424.     CLM   R0,1,=X'00'
  425.     BNE   SKPDEL         IF NO BKP, SKIP DELETE
  426.     SVC   DELETE         DELETE OLD BACKUP IF PRESENT
  427. SKPDEL   EQU   *
  428.     MVC   REN1(64),DSN1  COPY FILE NAME TO RENAME
  429.     L     R1,ATYPE1
  430.     MVC   1(3,R1),SAVETYPE  RESTORE OLD FILE NAME
  431.     SVC   RENAME         RENAME OLD FILE TO BKP
  432. SAVESKPR EQU   *
  433.     LA    R2,SYSUT1
  434.     SVC   OPEN
  435.     L     R12,GLBFIRST
  436.     USING LB,R12
  437.     LA    R5,100
  438.     ZAP   PTOTAL,=P'0'
  439.     XC    FINDKEY,FINDKEY
  440.     MVI   FINDKEY+ASCCR,X'FF'
  441. SAVELOOP EQU   *
  442.     LTR   R12,R12
  443.     BZ    SAVEEXIT
  444.     MVC   WLB(LLB),LB   MOVE NEXT LB TO WORKING STORAGE
  445.     MVC   WLBLINE+L'WLBLINE(2),=AL1(ASCCR,ASCLF) RESET PAD
  446.     TRT   WLBLINE(81),FINDKEY  FIND END OF RECORD
  447.     LA    R2,1(R1)
  448.     S     R2,=A(WLBLINE)
  449. SAVEBLKL EQU   *
  450.     BCTR  R1,0                 BACKUP TO FIRST NON-BLANK
  451.     CLI   0(R1),ASCBLK
  452.     BNE   SAVEBLKE
  453.     BCT   R2,SAVEBLKL
  454. SAVEBLKE EQU   *
  455.     MVC   1(2,R1),=AL1(ASCCR,ASCLF)   PUT CR,LF AFTER LAST CHAR
  456.     LA    R1,WLBLINE
  457.     CLI   ALC,TRUE                    IS FILE TYPE ALC
  458.     BNE   SAVESKPT
  459.     CLC   WLBLINE(9),=9AL1(ASCBLK)    ARE THERE 9 LEADING BLANKS
  460.     BNE   SAVESKPT
  461.     MVI   WLBLINE+8,ASCTAB            INSERT TAB
  462.     LA    R1,WLBLINE+8                WRITE FROM TAB
  463. SAVESKPT EQU   *
  464.     LA    R2,SYSUT1
  465.     SVC   PUT               PUT RECORD
  466.     L     R12,WLBNEXT
  467.     BCT   R5,SAVELOOP       REPEAT 100 TIMES
  468.     AP    PTOTAL,=P'100'
  469.     MVC   STATREC,=X'402020202020'
  470.     ED    STATREC,PTOTAL
  471.     LA    R3,STATREC
  472.     LA    R4,L'STATREC
  473.     BAL   R14,PUTSTAT       PRINT RECORD # EVERY 100 RECORDS
  474.     LA    R5,100
  475.     B     SAVELOOP
  476. SAVEEXIT EQU   *
  477.     LA    R2,SYSUT1
  478.     SVC   CLOSE
  479.     MVI   FILEMOD,FALSE
  480. SAVESKIP EQU   *
  481.     L     R5,SAVEROW
  482.     L     R6,SAVECOL
  483.     L     R7,SAVESCB
  484.     L     R14,SAVESV14
  485.     BR    R14
  486.     TITLE 'DISPLAY - DISPLAY 24 LINES AT CURRENT POINT IN FILE'
  487. DISPLAY  EQU   *
  488.     ST    R14,DISPSV14
  489.     MVC   SAVBLKLB,BLKLABEL  SAVE BLKLABEL MODE
  490.     BAL   R14,UPDATE     UPDATE SCREEN LINES IN EXTENDED STORAGE
  491.     BAL   R14,CLEAR   CLEAR DISPLAY AND RESET CURSOR
  492.     L     R12,GLBCUR  R12=A(CURRENT LB IN EXTENDED MEMORY)
  493.     LTR   R12,R12
  494.     BNZ   DISPOK
  495.     BAL   R14,NEWFILE INITIALIZE EMPTY FILE
  496.     L     R12,GLBCUR
  497. DISPOK   EQU   *
  498.     SR    R5,R5       RESET ROW
  499.     USING LB,R12
  500.     L     R7,ASCB     SCREEN TABLE
  501.     USING SCB,R7
  502. DISPLINE EQU   *
  503.     LTR   R12,R12     IS LB ADDRESS GT 0
  504.     BZ    DISPEXIT    NO, GO EXIT
  505.     ST    R12,SCBADDR SAVE ADDRESS OF LB
  506.     MVC   SCBLB(LLB),LB    MOVE CURRENT LINE TO SCB
  507.     MVI   SCBMOD,FALSE     SET MODIFY FALSE
  508.     SR    R3,R3            SET STARTING COL.
  509.     BAL   R14,PUTLINE
  510.     MVI   BLKLABEL,FALSE   TEMP TURN OFF BLKLABEL AFTER FIRST
  511. NEXTLINE EQU   *                LINE TO ONLY MARK FIRST LINE
  512.     ST    R5,LASTROW       SET LAST ROW
  513.     ST    R7,LASTSCB       SET LAST SCB ADDR
  514.     LA    R0,X'0100'
  515.     SVC   KEYBOARD
  516.     STCM  R0,4,KEY         PUT LOW FLAGS BYTE IN KEY
  517.     TM    KEY,X'40'        IS THERE A KEY WAITING
  518.     BZ    DISPEXIT         YES, EXIT NOW WITH SHORT SCREEN
  519.     LA    R5,X'100'(R5)    INCR ROW
  520.     LA    R6,X'00'         RESET COL
  521.     L     R12,SCBNEXT      ADDRESS OF NEXT LB
  522.     LA    R7,LSCB(R7)      INCR SCREEN CONTROL BLOCK
  523.     CL    R5,MAXROW
  524.     BNH   DISPLINE
  525. DISPEXIT EQU   *
  526.     MVC   BLKLABEL,SAVBLKLB RESTORE BLKLABEL MODE
  527.     LA    R5,0            RESET ROW,COL TO 0,0
  528.     LA    R6,0
  529.     L     R7,ASCB         RESET SCB ADDRESS
  530.     ZAP   PCURLINE,PCUR
  531.     ZAP   PCOL,=P'1'
  532.     BAL   R14,SETCUR      RESET CURSOR
  533.     L     R14,DISPSV14
  534.     BR    R14
  535.     TITLE 'SETCUR - SET CURSOR ON NEW DISPLAY'
  536. SETCUR   EQU   *
  537.     ST    R14,SETCSV14
  538.     CLC   PCURLINE,PCURLAST
  539.     BE    SCSKPREC
  540.     MVC   PCURLAST,PCURLINE
  541.     MVC   STATREC,=X'402020202120'
  542.     ED    STATREC,PCURLINE
  543.     LA    R3,STATREC
  544.     LA    R4,L'STATREC
  545.     BAL   R14,PUTSTAT
  546. SCSKPREC EQU   *
  547.     CLC   PCOL,PCOLLAST
  548.     BE    SCSKPCOL
  549.     MVC   PCOLLAST,PCOL
  550.     MVC   STATCOL,=X'40202120'
  551.     ED    STATCOL,PCOL
  552.     LA    R3,STATCOL
  553.     LA    R4,L'STATCOL
  554.     BAL   R14,PUTSTAT
  555. SCSKPCOL EQU   *
  556.     LA    R15,0(R5,R6)
  557.     LA    R0,X'0200'      AH=2 SET CURSOR
  558.     LA    R1,0            BH=0 PAGE
  559.     SVC   VIDEO
  560.     L     R14,SETCSV14
  561.     BR    R14
  562.     TITLE 'NEWFILE - INITIALIZE NEW FILE IN MEMORY'
  563. NEWFILE  EQU   *
  564.     ST    R14,NEWFSV14
  565.     BAL   R14,GETNEWLB
  566.     LTR   R15,R15
  567.     BZ    E03
  568.     L     R12,ANEWLB
  569.     ST    R12,GLBCUR
  570.     ST    R12,GLBFIRST
  571.     ST    R12,GLBLAST
  572.     ZAP   PCUR,=P'1'
  573.     ZAP   PLSTLINE,=P'1'
  574.     MVC   WLBPREV,=A(0)
  575.     MVC   WLBNEXT,=A(0)
  576.     MVC   WLBLINE,=AL1(ASCCR,ASCLF)
  577.     BAL   R14,CHKADDR
  578.     MVC   LB(LLB),WLB   INITIALIZE EMPTY LINE IN MEMORY
  579.     L     R14,NEWFSV14
  580.     SR    R15,R15
  581.     BR    R14
  582.     TITLE 'PUTLINE - DISPLAY CURRENT LINE'
  583. *
  584. * R3 = STARTING COLUMN
  585. *
  586. * IF IN MARKING MODE, USE REVERSE VIDEO AND SET ENDING BLOCK
  587. *
  588. PUTLINE  EQU   *
  589.     ST    R14,PUTLSV14
  590.     IC    R0,ATTRIB
  591.     STC   R0,ATTSAVE
  592.     CLI   BLKLABEL,MARK
  593.     BNE   PUTLINE1
  594.     MVC   BLK2LB,SCBADDR  UPDATE ENDING BLOCK
  595.     SLL   R0,4
  596.     LR    R1,R0
  597.     N     R1,=X'00000070' BG=FG  (TURN OFF HIGH INTENSITY/BLINK)
  598.     SRL   R0,8
  599.     N     R0,=X'00000007' FG=BG
  600.     OR    R1,R0
  601.     STC   R1,ATTRIB
  602.     OI    ATTRIB,X'08'    TURN ON INTENSITY FOR REVVERSE FG
  603. PUTLINE1 EQU   *
  604. ****************************************************************
  605. *DISPCHAR EQU   *                                              *
  606. *        CLI   0(R2),ASCBLK IS IT END OF LINE                  *
  607. *        BL    DSLNEXIT                                        *
  608. * MICRO  LA    R0,X'0200'  AH=2 SET CURSOR                     *
  609. * CODED  LA    R1,0        BH=0 PAGE                           *
  610. * AS     LA    R15,0(R5,R3) DH=ROW,DL=COL                      *
  611. * PC/370 SVC   VIDEO                                           *
  612. * SVC 24 LA    R0,X'0900'  AH=9                                *
  613. * FOR    LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE) *
  614. * SPEED  IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.                *
  615. * ON     LA    R14,1       CX=(COUNT OF CHAR TO WRITE)         *
  616. * MOST   IC    R0,0(R2)    AL=CHAR                             *
  617. * FREQ.  SVC   VIDEO       DISPLAY CHAR                        *
  618. * VIDEO  LA    R3,1(R3)    INCR COL                            *
  619. * FUNCT. LA    R2,1(R2)    INCR CHAR                           *
  620. *        B     DISPCHAR    REPEAT FOR LINE                     *
  621. *DSLNEXIT EQU   *                                              *
  622. ****************************************************************
  623.     LA    R2,SCBLINE(R3)
  624.     SR    R1,R1
  625.     IC    R1,ATTRIB    PUT BH=0 AND BL=ATTIRBUTE IN R1
  626.     LA    R15,0(R5,R3) PUT ROW AND COL IN R15
  627. *****************************************************************
  628.     SVC   PRINTTXT     PRINT LINE AT (R2) AT (R15) ON SCREEN
  629. *****************************************************************
  630.     STC   R15,SCBCOL   UPDATE ENDING COL.  (NOTE SVC USES R15
  631.     SR    R1,R1                             INSETEAD OF R3)
  632.     IC    R1,SCBCOL
  633.     LA    R1,SCBLINE(R1)
  634.     MVC   0(2,R1),=AL1(ASCCR,ASCLF)    ADD CR,LF
  635.     LA    R0,X'0200'  AH=2 SET CURSOR
  636.     LA    R1,0        BH=0 PAGE
  637.     LA    R15,0(R5,R6) DH=ROW,DL=COL
  638.     SVC   VIDEO
  639.     MVC   ATTRIB,ATTSAVE  RESET COLORS
  640.     L     R14,PUTLSV14
  641.     BR    R14
  642.     TITLE 'PUTMSG - DISPLAY 20 CHAR MSG AT R1'
  643. PUTMSG   EQU   *
  644.     MVC   STATMSG,0(R1)
  645.     LA    R3,STATMSG
  646.     LA    R4,L'STATMSG
  647.     B     PUTSTAT
  648.     TITLE 'PUTSTAT - DISPLAY DATA ON STATUS LINE'
  649. *
  650. * R3 = START OF TEXT IN STATUS LINE
  651. * R4 = LENGTH OF TEXT
  652. *
  653. PUTSTAT  EQU   *
  654.     ST    R14,PUTSSV14
  655.     LR    R1,R3
  656.     LR    R2,R4
  657.     SVC   EBCASC
  658.     LR    R2,R3
  659.     SR    R1,R1
  660.     STC   R1,0(R3,R4)  SET EOR FOR PRINTTXT
  661.     IC    R1,ATTRIB
  662.     LR    R15,R3
  663.     S     R15,=A(STATLINE-STATRC0)
  664.     SVC   PRINTTXT
  665.     LA    R0,X'0200'   AH=2 SET CURSOR
  666.     LA    R1,0         BH=0 PAGE
  667.     LA    R15,0(R5,R6) DH=ROW,DL=COL
  668.     SVC   VIDEO
  669.     L     R14,PUTSSV14
  670.     BR    R14
  671.     TITLE 'NEWSTAT - REFRESH STATUS LINE WITH CURRENT ATTRIBUTE'
  672. NEWSTAT  EQU   *
  673.     ST    R14,PUTSSV14
  674.     LA    R2,STATLINE
  675.     LA    R1,L'STATLINE
  676. NEWSTAT1 EQU   *
  677.     CLI   0(R2),ASCBLK
  678.     BNL   NEWSTAT2
  679.     MVI   0(R2),ASCBLK  CLEAR OUT INDIVIDUAL FIELD STOPS
  680. NEWSTAT2 EQU   *
  681.     LA    R2,1(R2)
  682.     BCT   R1,NEWSTAT1
  683.     SR    R1,R1
  684.     IC    R1,ATTRIB
  685.     LA    R2,STATLINE
  686.     L     R15,=A(STATRC0)
  687.     SVC   PRINTTXT
  688.     LA    R0,X'0200'   AH=2 SET CURSOR
  689.     LA    R1,0         BH=0 PAGE
  690.     LA    R15,0(R5,R6) DH=ROW,DL=COL
  691.     SVC   VIDEO
  692.     L     R14,PUTSSV14
  693.     BR    R14
  694.     TITLE 'PUTPCT - UPDATE % OF MEMORY CAPACITY IN USE'
  695. PUTPCT   EQU   *
  696.     ST    R14,PPCTSV14
  697.     ZAP   PWORK,PLSTLINE
  698.     CVB   R1,PWORK
  699.     MH    R1,=H'100'
  700.     SR    R0,R0
  701.     D     R0,FMAXLINE
  702.     CVD   R1,PWORK
  703.     MVC   STATPCT,=X'40202120'
  704.     ED    STATPCT,PWORK+6
  705.     LA    R3,STATPCT
  706.     LA    R4,L'STATPCT+1
  707.     MVI   STATPCT+L'STATPCT,C'%'
  708.     BAL   R14,PUTSTAT
  709.     L     R14,PPCTSV14
  710.     BR    R14
  711.     TITLE 'CLEAR - CLEAR SCREEN AND SET CURSOR TO UPPER LEFT'
  712. CLEAR    EQU   *
  713.     ST    R14,CLRSV14
  714.     LA    R0,X'0200'  AH=2 SET CURSOR
  715.     LA    R1,0        BH=0 PAGE
  716.     LA    R15,X'0000' DH=ROW,DL=COL
  717.     SVC   VIDEO       SET CURSOR TO UPPER LEFT CORNER
  718.     LA    R0,X'0920'  AH=10, AL=SPACE
  719.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  720.     IC    R1,ATTRIB
  721.     LA    R14,24*80   CHARACTERS ON DATA LINES
  722.     SVC   VIDEO       CLEAR DATA LINES
  723.     L     R14,CLRSV14
  724.     BR    R14
  725.     TITLE 'GETKEY - GET NEXT KEY INPUT'
  726. GETKEY   EQU   *
  727.     ST    R14,GETKSV14
  728.     MVC   LASTKEY,KEY     SAVE LAST KEY
  729.     CLI   KSMODE,KSREAD
  730.     BE    KSGET
  731. CHKNOW   EQU   *
  732.     LA    R0,X'0100'
  733.     SVC   KEYBOARD
  734.     STCM  R0,4,KEY        PUT LOW FLAGS BYTE IN KEY
  735.     TM    KEY,X'40'       IS THERE A KEY WAITING
  736.     BZ    GETNOW          YES, GO GET KEY NOW
  737.     BAL   R14,KEYSTATS    NO, GO UPDATE KEY STATUS FIRST
  738.     B     CHKNOW
  739. GETNOW   EQU   *
  740.     LA    R0,X'0000'
  741.     SVC   KEYBOARD        GET KEY FROM KEYBOARD BIA BIOS
  742.     STC   R0,KEY
  743.     CLI   KEY,X'00'       IS IT NULL CODE
  744.     BE    KEYEXT          YES, GET EXTENDED CODE
  745.     CLI   KEY,X'80'       IS IT ASCII 0-127
  746.     BL    KEYOK           YES, OK
  747.     MVI   KEY,X'00'       NO,  MAKE IT NULL
  748.     B     KEYOK
  749. KEYEXT   EQU   *
  750.     STCM  R0,2,KEY        STORE AH EXTENDED CODE
  751.     OI    KEY,X'80'       FORCE EXTENDED CODES TO 128+
  752. KEYOK    EQU   *
  753.     CLI   KSMODE,KSWRITE  IS KEYBOARD FILE BEING WRITTEN
  754.     BNE   GETKEXIT         NO, EXIT
  755. KSPUT    EQU   *               YES, PUT KEY
  756.     L     R1,KSNEXT
  757.     MVC   0(1,R1),KEY     MOVE KEY TO KS OUTPUT RECORD
  758.     LA    R1,1(R1)
  759.     ST    R1,KSNEXT
  760.     CL    R1,=A(KSRECEND)
  761.     BL    GETKEXIT
  762.     LA    R1,KSREC
  763.     ST    R1,KSNEXT       RESET NEXT POINTER
  764.     LA    R2,SYSUT2
  765.     SVC   PUT             WRITE KS RECORD
  766.     B     GETKEXIT
  767. KSGET    EQU   *
  768.     L     R1,KSNEXT
  769.     LA    R1,1(R1)
  770.     ST    R1,KSNEXT
  771.     CL    R1,=A(KSRECEND)
  772.     BL    KSGETOK
  773.     LA    R1,KSREC
  774.     ST    R1,KSNEXT
  775.     LA    R2,SYSUT2
  776.     SVC   GET             READ KS RECORD
  777. KSGETOK  EQU   *
  778.     MVC   KEY,0(R1)
  779. GETKEXIT EQU   *
  780.     L     R14,GETKSV14
  781.     BR    R14
  782.     TITLE 'AUDITSCB - AUDIT SCB'S AGAINST LB'S'
  783. AUDITSCB EQU   *
  784.     CLI   AUDIT,TRUE
  785.     BNER  R14
  786.     STM   R0,R3,SAVER0R3
  787.     LA    R0,0            ERR 0
  788.     LTR   R5,R5
  789.     BM    AUDITBUG                ROW LT 0
  790.     CL    R5,MAXROW
  791.     BH    AUDITBUG                ROW GT 23
  792.     LA    R0,10           ERR 10
  793.     LA    R1,LASTROW
  794.     LA    R2,LASTSCB
  795.     CL    R5,LASTROW
  796.     BH    AUDITBUG                ROW GT LASTROW
  797.     CL    R7,LASTSCB
  798.     BH    AUDITBUG                ASCB GT LASTSCB
  799.     LA    R0,11           ERR 11
  800.     LR    R1,R5
  801.     SRL   R1,8
  802.     MH    R1,=AL2(LSCB)
  803.     A     R1,ASCB
  804.     CLR   R1,R7                   ROW NE ASCB
  805.     BNE   AUDITBUG
  806.     L     R1,ASCB
  807.     SR    R2,R2
  808. AUDITL   EQU   *
  809.     L     R12,SCBADDR-SCB(R1)
  810.     MVC   WLB(8),LB
  811.     CLC   SCBLB-SCB(8,R1),WLB   CHECK LB POINTERS
  812.     LA    R0,1            ERR 1
  813.     BNE   AUDITBUG              SCB PREV/NEXT NE LB PREV/NEXT
  814.     LR    R3,R1
  815.     LA    R2,ROWINC(R2)
  816.     LA    R1,LSCB(R1)
  817.     CL    R2,LASTROW
  818.     BH    AUDITE
  819.     CLC   SCBNEXT-SCB(4,R3),SCBADDR-SCB(R1)
  820.     LA    R0,2            ERR 2
  821.     BNE   AUDITBUG             SCBNEXT EQ SCBADDR OF NEXT
  822.     CLC   SCBPREV-SCB(4,R1),SCBADDR-SCB(R3)
  823.     BNE   AUDITBUG             SCBPREV EQ SCBADDR OF PREV
  824.     B     AUDITL
  825. AUDITE   EQU   *
  826.     LM    R0,R3,SAVER0R3
  827.     BR    R14
  828. AUDITBUG EQU   *               ENTER PC/370 DEBUG WITH ERR IN R0
  829.     SVC   TRACE
  830.     DC    C'BUG '
  831.     B     *
  832.     TITLE 'AUDITMS - AUDIT MAIN STORAGE LBS'
  833. AUDITMS  EQU   *
  834.     CLI   AUDIT,TRUE
  835.     BNER  R14
  836.     STM   R0,R3,SAVER0R3
  837.     ZAP   PCHKLINE,=P'0'
  838.     MVC   WLBADDR,GLBFIRST
  839.     L     R12,WLBADDR
  840.     LTR   R12,R12
  841.     BZ    AUDITMSE
  842.     MVC   WLB(LLB),LB
  843.     LA    R0,3            ERR 3
  844.     LA    R1,WLBADDR
  845.     CLC   WLBPREV,=A(0)
  846.     BNE   AUDITBUG             FIRST LBPREV EQ 0
  847.     LA    R0,4            ERR 4
  848.     LA    R3,TLBADDR
  849. AUDITMSL EQU   *
  850.     AP    PCHKLINE,=P'1'
  851.     MVC   TLBADDR,WLBNEXT
  852.     L     R12,TLBADDR
  853.     LTR   R12,R12
  854.     BZ    AUDITMSE
  855.     MVC   TLB(LLB),LB
  856.     CLC   WLBADDR,TLBPREV
  857.     BNE   AUDITBUG             LP(I) EQ LPREV(I+1)
  858.     MVC   WLBADDR,TLBADDR
  859.     MVC   WLB(LLB),TLB
  860.     B     AUDITMSL
  861. AUDITMSE EQU   *
  862.     LA    R0,5           ERR 5
  863.     L     R1,WLBADDR
  864.     L     R3,GLBLAST
  865.     CLC   WLBADDR,GLBLAST
  866.     BNE   AUDITBUG            GLBLAST EQ LP(LAST)
  867.     LA    R0,6           ERR 6
  868.     LA    R1,PCHKLINE
  869.     LA    R3,PLSTLINE
  870.     CP    PCHKLINE,PLSTLINE
  871.     BNE   AUDITBUG            PLSTLINE EQ LB COUNT
  872.     LM    R0,R3,SAVER0R3
  873.     BR    R14
  874.     TITLE 'TERMKSF - FLUSH AND CLOSE KSF FILE IF ACTIVE'
  875. TERMKSF  EQU   *
  876.     ST    R14,TERMSV14
  877.     CLI   KSMODE,KSOFF    IS KEYBOARD FILE IN USE
  878.     BE    TERMKSFE        NO, EXIT NOW
  879.     CLI   KSMODE,KSWRITE  IS IT WRITE
  880.     BNE   TERMKSFC        NO, GO CLOSE IT
  881.     L     R1,KSNEXT
  882.     CL    R1,=A(KSREC)    IS THERE DATA IN LAST RECORD
  883.     BE    TERMKSFC        NO, GO CLOSE IT
  884.     LA    R1,KSREC
  885.     LA    R2,SYSUT2
  886.     SVC   PUT             YES, WRITE LAST KS RECORD
  887. TERMKSFC EQU   *
  888.     LA    R2,SYSUT2
  889.     SVC   CLOSE           CLOSE KS FILE
  890. TERMKSFE EQU   *
  891.     L     R14,TERMSV14
  892.     BR    R14
  893.     TITLE 'KEYSTATS - UPDATE CAPS, INSERT, NUMLOCK STATUS'
  894. KEYSTATS EQU   *
  895.     ST    R14,KEYSSV14
  896.     LA    R0,X'0200'  AH=2 RETURN SHIFT STATUS
  897.     SVC   KEYBOARD    READ SHIFT STATUS INTO AL (TECH. A-26)
  898. ******
  899. *
  900. *  NOTE INS STATE IS TOGGLED BY KEY ROUTINE ALWAYS STARTING IN OFF
  901. *  STATE RATHER THAN USING MS-DOS TOGGLED STATUS WHICH MAY OR MAY
  902. *  NOT BE OFF AT START OF PROGRAM.  (USER MAY CHANGE OPTION. IF YOU
  903. *  DO REMEMBER TO DISABLE TOGGLE IN KRINS ROUTINE.)
  904. *
  905. *        STC   R0,KBINS
  906. *        NI    KBINS,INSSTATE
  907. *
  908. *****
  909.     STC   R0,KBCAP         SET CAP STATUS
  910.     NI    KBCAP,CAPSTATE
  911.     STC   R0,KBNUM         SET NUM STATUS
  912.     NI    KBNUM,NUMSTATE
  913. KEYSINS  EQU   *
  914.     CLC   KBINS,KBINSLST
  915.     BE    KEYSCAP
  916.     CLI   KBINS,INSSTATE
  917.     MVC   STATINS,=C'INS'
  918.     BE    KEYSINSU
  919.     MVC   STATINS,=C'   '
  920. KEYSINSU EQU   *
  921.     MVC   KBINSLST,KBINS
  922.     LA    R3,STATINS
  923.     LA    R4,L'STATINS
  924.     BAL   R14,PUTSTAT
  925. KEYSCAP  EQU   *
  926.     CLC   KBCAP,KBCAPLST
  927.     BE    KEYSNUM
  928.     CLI   KBCAP,CAPSTATE
  929.     MVI   KBCAP,CAPSTATE
  930.     MVC   STATCAP,=C'CAP'
  931.     BE    KEYSCAPU
  932.     MVI   KBCAP,0
  933.     MVC   STATCAP,=C'   '
  934. KEYSCAPU EQU   *
  935.     MVC   KBCAPLST,KBCAP
  936.     LA    R3,STATCAP
  937.     LA    R4,L'STATCAP
  938.     BAL   R14,PUTSTAT
  939. KEYSNUM  EQU   *
  940.     CLC   KBNUM,KBNUMLST
  941.     BE    KEYSEXIT
  942.     CLI   KBNUM,NUMSTATE
  943.     MVI   KBNUM,NUMSTATE
  944.     MVC   STATNUM,=C'NUM'
  945.     BE    KEYSNUMU
  946.     MVI   KBNUM,0
  947.     MVC   STATNUM,=C'   '
  948. KEYSNUMU EQU   *
  949.     MVC   KBNUMLST,KBNUM
  950.     LA    R3,STATNUM
  951.     LA    R4,L'STATNUM
  952.     BAL   R14,PUTSTAT
  953. KEYSEXIT EQU   *
  954.     L     R14,KEYSSV14
  955.     BR    R14
  956.     TITLE 'KR - KEY CONTROL ROUTINES'
  957. *
  958. * ALL ROUTINES STARTING WITH KR..... ARE ACCESSED VIA BALR FROM EDIT
  959. * BASED ON USE OF EXTENDED ASCII KEYBOARD INPUT BYTE USED AS INDEX
  960. * INTO KEYTAB TO OFFSET TO KRTAB ADDRESS TABLE POINTER TO KR ROUTINE.
  961. * THIS IDEXING SCEME CAN HANDLE UP TO 63 KR ROUTINES.
  962. *
  963. KRUND    EQU   *              PROCESS UNDEFINED KEY
  964.     BR    R14
  965. KRCHAR   EQU   *              PROCESS ASCII CHARACTER
  966.     ST    R14,KRSV14
  967.     BAL   R14,KRSETCHR
  968.     LA    R6,1(R6)       INCR COL
  969.     AP    PCOL,=P'1'
  970.     MVC   STATCOL,=X'40202020'
  971.     ED    STATCOL,PCOL
  972.     LA    R3,STATCOL+2
  973.     LA    R4,2
  974.     BAL   R14,PUTSTAT
  975.     MVC   PCOLLAST,PCOL
  976.     CH    R6,=H'80'      WRAP IF END OF LINE
  977.     BL    KRCHARS2
  978.     LA    R6,0           RESET COL
  979.     ZAP   PCOL,=P'1'
  980.     LA    R5,ROWINC(R5)  INCR ROW
  981.     AP    PCURLINE,=P'1'
  982.     LA    R7,LSCB(R7)    INCR SCB LINE
  983.     CL    R5,LASTROW     WRAP IF LAST LINE
  984.     BNH   KRCHARS1
  985.     LA    R5,0           RESET ROW
  986.     ZAP   PCURLINE,PCUR
  987.     L     R7,ASCB        RESET SCB
  988. KRCHARS1 EQU   *              UPDATE CURSOR ON SCREEN
  989.     BAL   R14,SETCUR
  990. KRCHARS2 EQU   *
  991.     LA    R0,X'0200'     AH=2 SET CURSOR
  992.     LA    R1,0           BH=0 PAGE
  993.     LA    R15,0(R5,R6)   DH=ROW,DL=COL
  994.     SVC   VIDEO
  995.     L     R14,KRSV14
  996.     BR    R14
  997. KRSETCHR EQU   *              STORE KEY AT CURSOR
  998.     ST    R14,SCHRSV14
  999.     MVI   SCBMOD,TRUE    SET MOD SWITCH FOR CURRENT LINE
  1000.     MVI   SCRMOD,TRUE    SET MOD SWITCH FOR CURRENT SCREEN
  1001.     CLM   R6,1,SCBCOL    IS NEW CHAR PAST END OF LINE
  1002.     BL    KRCHARCI       NO, GO CHECK INSERT MODE
  1003.     SR    R2,R2
  1004.     IC    R2,SCBCOL      R2 = OLD COL
  1005.     LR    R1,R6
  1006.     SR    R1,R2
  1007.     LA    R2,SCBLINE(R2)
  1008.     MVI   0(R2),ASCBLK   INIT PAD
  1009.     EX    R1,MVCPAD      EXTEND PAD TO NEW COLUMN
  1010.     LA    R1,1(R6)
  1011.     STC   R1,SCBCOL      SET NEW ENDING COL
  1012.     LA    R2,SCBLINE(R1)
  1013.     MVC   0(2,R2),=AL1(ASCCR,ASCLF) ADD CR,NL
  1014. KRCHAROK EQU   *
  1015.     LA    R0,X'0900'     AH=9
  1016.     LA    R1,X'0000'     BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE)
  1017.     IC    R1,ATTRIB      BL=ATRIBUTE OF CHAR.
  1018.     LA    R14,1          CX=(COUNT OF CHAR TO WRITE)
  1019.     IC    R0,KEY         AL=CHAR.
  1020.     STC   R0,SCBLINE(R6) STORE CHARACTER IN SCREEN TEXT
  1021.     SVC   VIDEO          DISPLAY ASCII CHAR
  1022.     L     R14,SCHRSV14
  1023.     BR    R14
  1024. MVCPAD   MVC   1(0,R2),0(R2)  PAD TO NEW COLUMN
  1025. KRCHARCI EQU   *              CHECK INSERT MODE
  1026.     CLI   KBINS,INSSTATE
  1027.     BNE   KRCHAROK       NO, GO STORE CHAR AND EXIT
  1028.     CLM   R6,1,=AL1(79)  IS THIS LAST CHAR
  1029.     BE    KRCHAROK       YES, GO STORE CHAR AND EXIT
  1030.     LA    R2,SCBLINE(R6)
  1031.     SR    R1,R1
  1032.     IC    R1,SCBCOL
  1033.     LA    R1,1(R1)
  1034.     STC   R1,SCBCOL      UPDATE ENDING COL
  1035.     SR    R1,R6          R1 = LENGTH OF TEXT + 2 - 1
  1036.     EX    R1,INSMVC1     SAVE TEXT TO BE SHIFTED
  1037.     EX    R1,INSMVC2     MOVE TEXT BACK SHIFTED RIGHT
  1038.     IC    R2,KEY
  1039.     STC   R2,SCBLINE(R6) STORE CHARACTER IN SCREEN TEXT
  1040.     LR    R3,R6
  1041.     BAL   R14,PUTLINE    UPDATE SHIFTED LINE
  1042.     L     R14,SCHRSV14
  1043.     BR    R14
  1044. INSMVC1  MVC   WLBLINE(0),0(R2) MOVE TEXT TO BE SHIFTED RIGHT
  1045. INSMVC2  MVC   1(0,R2),WLBLINE  MOVE TEXT BACK SHIFTED RIGHT 1
  1046. KRESC    EQU   *              PROCESS ESCAPE KEY
  1047.     MVI   EOJ,TRUE
  1048.     BR    R14
  1049. KRPGUP   EQU   *              PROCESS PAGE UP KEY
  1050.     ST    R14,KRSV14
  1051.     L     R12,GLBCUR
  1052.     USING LB,R12
  1053.     LA    R3,12
  1054. KRPGUPL  EQU   *
  1055.     MVC   WLBPREV,LBPREV
  1056.     L     R12,WLBPREV
  1057.     LTR   R12,R12
  1058.     BZ    KRPGUPE
  1059.     ST    R12,GLBCUR
  1060.     SP    PCUR,=P'1'
  1061.     BCT   R3,KRPGUPL
  1062. KRPGUPE  EQU   *
  1063.     BAL   R14,DISPLAY
  1064.     L     R14,KRSV14
  1065.     BR    R14
  1066. KRPGDN   EQU   *              PROCESS PAGE DOWN KEY
  1067.     ST    R14,KRSV14
  1068.     L     R12,GLBCUR
  1069.     LA    R3,12
  1070. KRPGDNL  EQU   *
  1071.     MVC   WLBNEXT,LBNEXT
  1072.     L     R12,WLBNEXT
  1073.     LTR   R12,R12
  1074.     BZ    KRPGDNE
  1075.     ST    R12,GLBCUR
  1076.     AP    PCUR,=P'1'
  1077.     BCT   R3,KRPGDNL
  1078. KRPGDNE  EQU   *
  1079.     BAL   R14,DISPLAY
  1080.     L     R14,KRSV14
  1081.     BR    R14
  1082. KRF1     EQU   *            F1 FOR HELP SCREEN 1
  1083.     ST    R14,KRSV14
  1084.     BAL   R14,CLEAR
  1085.     LA    R2,F1SC
  1086.     L     R3,=A(F1SCEND)
  1087.     BAL   R14,HELPSCRN
  1088.     BAL   R14,GETKEY   WAIT FOR ANY KEY
  1089.     L     R14,KRSV14
  1090.     CLI   KEY,ASCF2
  1091.     BE    KRF2         SWITCH HELP SCREEN WITHOUT DISPLAY
  1092. KRF1COM  EQU   *
  1093.     LA    R15,KRALTF1
  1094.     CLI   KEY,ASCALTF1
  1095.     BE    KRF1WAIT
  1096.     LA    R15,KRALTF2
  1097.     CLI   KEY,ASCALTF2
  1098.     BNE   KRF1SKPW
  1099. KRF1WAIT EQU   *
  1100.     BALR  R14,R15      GO WAIT FOR ALT-F1 OR F2
  1101. KRF1SKPW EQU   *            NOW CLEAR HELP SCREEN
  1102.     BAL   R14,DISPLAY
  1103.     L     R14,KRSV14
  1104.     BR    R14
  1105. HELPSCRN EQU   *            DISPLAY HELP SCREEN
  1106.     LA    R4,0
  1107. HELPLOOP EQU   *
  1108.     ST    R14,HELPSV14
  1109.     SR    R1,R1
  1110.     IC    R1,ATTRIB
  1111.     LR    R15,R4
  1112.     SVC   PRINTTXT
  1113.     LA    R4,ROWINC(R4)
  1114.     CLR   R2,R3
  1115.     BL    HELPLOOP
  1116.     L     R14,HELPSV14
  1117.     BR    R14
  1118. KRF2     EQU   *            F2 FOR HELP SCREEN 2
  1119.     ST    R14,KRSV14
  1120.     BAL   R14,CLEAR
  1121.     L     R2,=A(F2SC)
  1122.     L     R3,=A(F2SCEND)
  1123.     BAL   R14,HELPSCRN
  1124.     BAL   R14,GETKEY   WAIT FOR ANY KEY
  1125.     L     R14,KRSV14
  1126.     CLI   KEY,ASCF1
  1127.     BE    KRF1         SWITCH HELP SCREEN WITHOUT DISPLAY
  1128.     B     KRF1COM
  1129. KRUP     EQU   *            CURSOR UP
  1130.     ST    R14,KRSV14
  1131.     MVI   DIRNEW,DIRUP
  1132.     BAL   R14,KRCHKBOX
  1133.     LTR   R5,R5
  1134.     BNZ   KRUPROW
  1135.     L     R12,SCBPREV
  1136.     LTR   R12,R12
  1137.     BZ    KRUPEXIT
  1138.     ST    R12,GLBCUR
  1139.     SP    PCUR,=P'1'
  1140.     ZAP   PCURLINE,PCUR
  1141.     BAL   R14,CHKMARK
  1142.     BAL   R14,SCRLDOWN
  1143.     L     R12,GLBCUR
  1144.     MVC   SCBLB(LLB),LB    MOVE NEW CURRENT LB TO FIRST LINE
  1145.     ST    R12,SCBADDR
  1146.     ST    R12,GLBCUR
  1147.     SR    R3,R3
  1148.     BAL   R14,PUTLINE
  1149.     MVI   SCBMOD,FALSE
  1150.     B     KRUPEXIT
  1151. KRUPROW  EQU   *
  1152.     BAL   R14,CHKMARK
  1153.     SP    PCURLINE,=P'1'
  1154.     SH    R5,=AL2(ROWINC)
  1155.     SH    R7,=AL2(LSCB)
  1156. KRUPEXIT EQU   *
  1157.     BAL   R14,SETCUR
  1158.     L     R14,KRSV14
  1159.     BR    R14
  1160. KRDOWN   EQU   *            CURSOR DOWN
  1161.     ST    R14,KRSV14
  1162.     MVI   DIRNEW,DIRDOWN
  1163.     BAL   R14,KRCHKBOX
  1164.     CL    R5,LASTROW
  1165.     BL    KRDOWNRW
  1166.     L     R12,SCBNEXT
  1167.     LTR   R12,R12      IS THERE A NEXT LINE
  1168.     BZ    KRDOWNXT     NO, EXIT NOW
  1169.     CL    R5,MAXROW    IS THERE ANOTHER LINE ON SCREEN
  1170.     BL    KRDOWNAR     YES, GO ADD IT
  1171.     ST    R12,WLBNEXT
  1172.     SR    R3,R3
  1173.     LR    R4,R5
  1174.     L     R7,ASCB
  1175.     BAL   R14,SCRLUP   NO, SCROLL SCREEN UP
  1176.     L     R7,ASCB
  1177.     MVC   GLBCUR,SCBADDR  UPDATE SCREEN CURRENCY
  1178.     AP    PCUR,=P'1'
  1179.     L     R7,MAXSCB
  1180.     L     R12,WLBNEXT
  1181. KRDOWNNR EQU   *            UPDATE NEW ROW
  1182.     MVC   SCBLB(LLB),LB
  1183.     ST    R12,SCBADDR
  1184.     SR    R3,R3
  1185.     BAL   R14,PUTLINE
  1186.     MVI   SCBMOD,FALSE
  1187.     AP    PCURLINE,=P'1'
  1188.     B     KRDOWNXT
  1189. KRDOWNAR EQU   *
  1190.     AH    R5,=AL2(ROWINC)
  1191.     AH    R7,=AL2(LSCB)
  1192.     ST    R5,LASTROW
  1193.     ST    R7,LASTSCB
  1194.     B     KRDOWNNR
  1195. KRDOWNRW EQU   *            MOVE CURSOR DOWN ROW
  1196.     AP    PCURLINE,=P'1'
  1197.     AH    R5,=AL2(ROWINC)
  1198.     AH    R7,=AL2(LSCB)
  1199. KRDOWNXT EQU   *
  1200.     BAL   R14,SETCUR
  1201.     BAL   R14,CHKMARK
  1202.     L     R14,KRSV14
  1203.     BR    R14
  1204. KRLEFT   EQU   *            CURSOR LEFT
  1205.     ST    R14,KRSV14
  1206.     MVI   DIRNEW,DIRLEFT
  1207.     BAL   R14,KRCHKBOX
  1208.     BCTR  R6,0
  1209.     SP    PCOL,=P'1'
  1210.     BNZ   KRLEFT1
  1211.     LA    R6,79
  1212.     ZAP   PCOL,=P'80'
  1213. KRLEFT1  EQU   *
  1214.     BAL   R14,SETCUR
  1215.     L     R14,KRSV14
  1216.     BR    R14
  1217. KRRIGHT  EQU   *            CURSOR RIGHT
  1218.     ST    R14,KRSV14
  1219.     MVI   DIRNEW,DIRRIGHT
  1220.     BAL   R14,KRCHKBOX
  1221.     AP    PCOL,=P'1'
  1222.     LA    R6,1(R6)
  1223.     CH    R6,=AL2(79)
  1224.     BNH   KRRIGHT1
  1225.     ZAP   PCOL,=P'1'
  1226.     LA    R6,0
  1227. KRRIGHT1 EQU   *
  1228.     BAL   R14,SETCUR
  1229.     L     R14,KRSV14
  1230.     BR    R14
  1231. KRCHKBOX EQU   *             SET BOX CHAR AT CURSOR IF BOX MODE
  1232.     SR    R1,R1
  1233.     IC    R1,DIRLAST
  1234.     MVC   DIRLAST,DIRNEW
  1235.     CLI   BOX,TRUE
  1236.     BNER  R14
  1237.     ST    R14,KRBXSV14
  1238.     IC    R0,REVDIR(R1)
  1239.     STC   R0,REVLAST    SAVE REVERSE OF LAST DIRECTION
  1240.     SLL   R1,2
  1241.     LA    R2,DIRTAB(R1) SELECT TABLE ROW BASED ON 4*DIRLAST
  1242.     IC    R1,DIRNEW
  1243.     IC    R1,0(R1,R2)   R1 = DIRECTION KEY INDEX
  1244.     L     R2,BOXSETA
  1245.     IC    R1,0(R1,R2)   R1 = KEY FROM INDEXED SET
  1246.     STC   R1,KEY        SELECT KEY FROM BOXSET(NEWDIR,OLDDIR)
  1247.     CLI   CONNECT,TRUE
  1248.     BNE   KRCHKBOK      KEY OK IF NOT IN CONNECT MODE
  1249.     CLM   R6,1,SCBCOL
  1250.     BNL   KRCHKBOK      KEY OK IF NO PREVIOUS CHARACTER AT CURSOR
  1251.     SR    R0,R0
  1252.     IC    R0,SCBLINE(R6)
  1253.     SH    R0,=AL2(179)  R0 = GRAPHIC CHAR. INDEX
  1254.     BM    KRCHKBOK      KEY OK IF CHAR AT CURSOR < FIRST GRAPHIC
  1255.     CLM   R0,1,=AL1(218-179)
  1256.     BH    KRCHKBOK      KEY OK IF CHAR AT CURSOR > LAST GRAPHIC
  1257.     CL    R2,=A(BOXSET1) IS CURRENT BOX SET SINGLE LINE
  1258.     BNE   KRCHKBS2
  1259.     LA    R2,BOXCON     R2 = BOXCON( SINGLE BOX SET)
  1260.     B     KRCHKBCN
  1261. KRCHKBS2 EQU   *
  1262.     CL    R2,=A(BOXSET2) IS CURRENT BOX SET DOUBLE LINE
  1263.     BNE   KRCHKBOK      NO, KEY OK AS IS
  1264.     LA    R2,BOXCON+4   R2 = BOXCON( DOUBLE BOX SET)
  1265. KRCHKBCN EQU   *             USE BOX CONNECT TABLE TO CONNECT NEW DIR
  1266.     SLL   R0,3
  1267.     LR    R1,R2
  1268.     AR    R1,R0         R1 = A(BOXCON(S/D SET, OLD CHAR))
  1269.     SR    R0,R0
  1270.     IC    R0,DIRNEW
  1271.     AR    R1,R0         R1 = A(BOXCON(S/D SET, OLD CHAR, NEWDIR))
  1272.     IC    R0,0(R1)
  1273.     SH    R0,=AL2(179)  CONVERT NEW KEY TO INDEX
  1274.     SLL   R0,3          REPEAT PROCESS TO CONNECT OLD DIR LINE
  1275.     LR    R1,R2
  1276.     AR    R1,R0
  1277.     SR    R0,R0
  1278.     IC    R0,REVLAST    USE REVERSE OF OLD DIR TO SHARE BOXCON
  1279.     AR    R1,R0
  1280.     IC    R0,0(R1)
  1281.     STC   R0,KEY        SET NEW GRAPHIC CHAR WITH CONNECTIONS
  1282. KRCHKBOK EQU   *
  1283.     BAL   R14,KRSETCHR  STORE KEY AT CURSOR
  1284. KRCHKBX1 EQU   *
  1285.     LA    R0,X'0100'
  1286.     SVC   KEYBOARD
  1287.     STCM  R0,4,PWORK
  1288.     TM    PWORK,X'40'   IS THERE ANOTHER KEY WAITING
  1289.     BNZ   KRCHKBX2      NO, PROCEED
  1290.     LA    R0,X'0000'
  1291.     SVC   KEYBOARD      YES, FLUSH KEY AND TRY AGAIN
  1292.     B     KRCHKBX1
  1293. KRCHKBX2 EQU   *
  1294.     L     R14,KRBXSV14
  1295.     BR    R14
  1296. KRINS    EQU   *            INSERT KEY TOGGLED - UPDATE STATUS LINE
  1297.     ST    R14,KRSV14
  1298.     XI    KBINS,INSSTATE  TOGGLE INS (IGNORE INS STATUS LINE)
  1299.     BAL   R14,KEYSTATS
  1300.     L     R14,KRSV14
  1301.     BR    R14
  1302. KRDEL    EQU   *            DELETE CHAR OR BLOCK VIA DEL KEY
  1303.     ST    R14,KRSV14
  1304.     CLI   BLKLABEL,FALSE   IS THERE A LABELED BLOCK
  1305.     BNE   KRDELBLK         YES, GO DELETE IT
  1306. KRDELCHR EQU   *
  1307.     CLM   R6,1,SCBCOL  IS CURSOR PAST END OF LINE
  1308.     BNLR  R14          YES, IGNORE DELETE KEY
  1309.     MVI   SCBMOD,TRUE  LINE MOD
  1310.     MVI   SCRMOD,TRUE  SCREEN MOD
  1311.     SR    R1,R1
  1312.     IC    R1,SCBCOL
  1313.     BCTR  R1,0
  1314.     STC   R1,SCBCOL    UPDATE ENDING COL
  1315.     LR    R4,R1        SAVE COL TO BLANK ON SCREEN
  1316.     LA    R1,2(R1)
  1317.     SR    R1,R6
  1318.     LA    R2,SCBLINE(R6)
  1319.     EX    R1,MVCLEFT   SHIFT TEXT ONLY TO OVERLAY DEL CHAR
  1320.     LA    R0,X'0200'   AH=2 SET CURSOR
  1321.     LA    R1,0         BH=0 PAGE
  1322.     LA    R15,0(R5,R4) DH=ROW,DL=COL  OLD LAST CHAR
  1323.     SVC   VIDEO        UPDATE CURSOR
  1324.     LA    R0,X'0920'  AH=9, AL= ASCII BLANK
  1325.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  1326.     IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.
  1327.     LA    R14,1       CX=(COUNT OF CHAR TO WRITE)
  1328.     SVC   VIDEO       DISPLAY CHAR
  1329.     LR    R3,R6
  1330.     BAL   R14,PUTLINE  REFRESH LINE TO NEW END OF LINE
  1331.     BAL   R14,SETCUR
  1332.     L     R14,KRSV14
  1333.     BR    R14
  1334. MVCLEFT  MVC   0(0,R2),1(R2)
  1335. KRCTLKY  EQU   *            DELETE LABELED BLOCK VIA CTL-K Y
  1336.     ST    R14,KRSV14
  1337.     CLI   BLKLABEL,FALSE
  1338.     BER   R14
  1339. KRDELBLK EQU   *            DELETE LABELED BLOCK
  1340.     LA    R1,=CL20'DELETE BLOCK'
  1341.     BAL   R14,PUTMSG
  1342.     MVI   CURDEL,FALSE RESET CURRENT LB DELETE SWITCH
  1343.     ZAP   PBLKCNT,=P'0'
  1344.     L     R12,BLK1LB
  1345. KRDELBK1 EQU   *            CHECK IF CURRENT LB IN BLOCK
  1346.     AP    PBLKCNT,=P'1'
  1347.     CL    R12,GLBCUR   IS CURRENT LINE BEING DELETED
  1348.     BNE   KRDELBKC
  1349.     MVI   CURDEL,TRUE  YES, SET SWITCH
  1350. KRDELBKC EQU   *
  1351.     CL    R12,BLK2LB
  1352.     BE    KRDELBK2    OK, GO DELETE BLOCK
  1353.     MVC   WLBNEXT,LBNEXT  GET NEXT LB TO DUP.
  1354.     L     R12,WLBNEXT
  1355.     LTR   R12,R12
  1356.     BNZ   KRDELBK1
  1357.     LA    R1,=CL20'BLOCK NOT FOUND'
  1358.     BAL   R14,PUTMSG
  1359.     B     KRDEXIT
  1360. KRDELBK2 EQU   *            OK TO DELETE BLOCK
  1361.     MVI   SCRMOD,TRUE     SET SCREEN MOD
  1362.     L     R12,BLK1LB
  1363.     MVC   WLBPREV,LBPREV  GET PREV. FROM FIRST BLOCK
  1364.     L     R12,BLK2LB
  1365.     BAL   R14,CHKADDR
  1366.     MVC   WLBNEXT,LBNEXT  GET NEXT  FROM LAST  BLOCK
  1367.     MVC   LBNEXT,AFREELB  CHAIN FREE QUEUE TO LAST
  1368.     MVC   AFREELB,BLK1LB            SET   FREE QUEUE TO FIRST
  1369.     L     R12,WLBPREV
  1370.     LTR   R12,R12
  1371.     BZ    KRDELFST                  GO SET NEW FIRST LB
  1372.     BAL   R14,CHKADDR
  1373.     MVC   LBNEXT,WLBNEXT  CHAIN PREV TO NEXT
  1374.     B     KRDELCKL
  1375. KRDELFST EQU   *
  1376.     MVC   GLBFIRST,WLBNEXT         RESET FIRST PAST BLOCK
  1377. KRDELCKL EQU   *
  1378.     L     R12,WLBNEXT
  1379.     LTR   R12,R12
  1380.     BZ    KRDELLST
  1381.     SP    PLSTLINE,PBLKCNT
  1382.     BAL   R14,CHKADDR
  1383.     MVC   LBPREV,WLBPREV CHAIN NEXT TO PREV
  1384.     B     KRDELCUR
  1385. KRDELLST EQU   *
  1386.     MVC   GLBLAST,WLBPREV          RESET LAST TO PREV
  1387.     ZAP   PLSTLINE,PCURBLK1
  1388.     SP    PLSTLINE,=P'1'
  1389. KRDELCUR EQU   *
  1390.     CLI   CURDEL,TRUE              IS CURRENT LB DELETED
  1391.     BNE   KRDEXIT                  NO, EXIT WITH DISPLAY REQ.
  1392.     ZAP   PCUR,PCURBLK1
  1393.     SP    PCUR,=P'1'
  1394.     MVC   GLBCUR,WLBPREV           YES, TRY PREV
  1395.     CLC   GLBCUR,=A(0)             IS PREV ZERO
  1396.     BNE   KRDEXIT                  NO, EXIT
  1397.     ZAP   PCUR,=P'1'
  1398.     MVC   GLBCUR,WLBNEXT           YES, TRY NEXT
  1399. KRDEXIT  EQU   *
  1400.     MVI   BLKLABEL,FALSE           RESET LABEL
  1401.     MVC   STATBLK,=C'   '
  1402.     LA    R3,STATBLK
  1403.     LA    R4,L'STATBLK
  1404.     BAL   R14,PUTSTAT
  1405.     BAL   R14,AUDITMS
  1406.     BAL   R14,PUTPCT
  1407.     BAL   R14,DISPLAY
  1408.     L     R14,KRSV14
  1409.     BR    R14
  1410. KRCR     EQU   *            CARRIAGE RETURN (ENTER)
  1411.     ST    R14,KRCRSV14
  1412.     CLI   KBINS,INSSTATE     INSERT MODE
  1413.     BE    KRINSLN      YES GO INSERT LINE
  1414.     BAL   R14,KRDOWN   NO, MOVE DOWN LINE
  1415.     B     KRINSEXT     EXIT
  1416. KRINSLN  EQU   *            INSERT LINE
  1417.     L     R12,SCBADDR
  1418.     BAL   R14,GETNEWLB GET FREE LB IN EXT. MEMORY
  1419.     L     R14,KRCRSV14
  1420.     LTR   R15,R15
  1421.     BNZR  R14          IGNORE REQUEST IF NO ROOM
  1422.     AP    PLSTLINE,=P'1'
  1423.     MVI   FILEMOD,TRUE SET FILE CHANGE
  1424.     MVI   SCRMOD,TRUE  SET SCREEN MODE
  1425.     LTR   R6,R6
  1426.     BNZ   KRINSAFT     IF NOT COL 0, INSERT AFTER CURRENT LINE
  1427.     L     R12,SCBPREV
  1428.     LTR   R12,R12
  1429.     BNZ   KRINSPRE     IF NOT FIRST, INSERT AFTER PREV. LINE
  1430. KRINSFST EQU   *            ELSE MAKE NEW LINE FIRST LINE
  1431.     MVC   GLBFIRST,ANEWLB  RESET FIRST LB POINTER
  1432.     MVC   GLBCUR,ANEWLB    RESET CURRENT LB POINTER
  1433.     MVC   WLBPREV,=A(0)    SET NO PREV.
  1434.     MVC   WLBNEXT,SCBADDR  CHAIN OLD CURRENT TO NEW
  1435.     BAL   R14,SCRLDOWN  SCROLL DOWN AND ADJUST SCB'S
  1436.     BAL   R14,KRINSWLB  CREATE NULL LB AND UPDATE SCB'S
  1437.     B     KRINSEXT
  1438. KRINSPRE EQU   *
  1439.     LTR   R5,R5        IS THIS FIRST LINE
  1440.     BNZ   KRINSSKC     NO, LEAVE CURRENT LINE ON SCREEN
  1441.     SP    PCUR,=P'1'
  1442.     SP    PCURLINE,=P'1'
  1443.     MVC   GLBCUR,SCBPREV  YES, MOVE PREV. LINE TO TOP LINE
  1444.     MVC   WLBPREV,SCBPREV CHAIN NEW LINE TO PREV. LB
  1445.     MVC   WLBNEXT,SCBADDR
  1446.     BAL   R14,SCRLDOWN MOVE FIRST TWO LINES DOWN
  1447.     BAL   R14,SCRLDOWN
  1448.     L     R12,GLBCUR
  1449.     MVC   SCBLB(LLB),LB
  1450.     ST    R12,SCBADDR
  1451.     SR    R3,R3
  1452.     BAL   R14,PUTLINE
  1453.     MVI   SCBMOD,FALSE
  1454.     LA    R5,ROWINC(R5) RESET CURSOR TO SECOND LINE
  1455.     LA    R7,LSCB(R7)
  1456.     BAL   R14,KRINSWLB  INSERT NEW LB AND UPDATE SCB
  1457.     B     KRINSEXT
  1458. KRINSSKC EQU   *            LINK BETWEEN PREV AND CURRENT
  1459.     MVC   WLBPREV,SCBPREV
  1460.     MVC   WLBNEXT,SCBADDR
  1461.     BAL   R14,SCRLDOWN SCROLL DOWN
  1462.     BAL   R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
  1463.     B     KRINSEXT
  1464. KRINSAFT EQU   *            LINK BETWEEN CURRENT AND NEXT
  1465.     CLC   SCBNEXT,=A(0)  IS NEW LINE AT END
  1466.     BNE   KRINSANL       NO, SKIP UPDATE TO LAST
  1467.     MVC   GLBLAST,ANEWLB
  1468. KRINSANL EQU   *
  1469.     MVC   WLBPREV,SCBADDR
  1470.     MVC   WLBNEXT,SCBNEXT
  1471.     CL    R5,MAXROW
  1472.     BL    KRINSASD     IF NOT LAST ROW, SCROLL DOWN
  1473. KRINSASU EQU   *            SCROLL UP FOR NEW LINE ON LAST ROW
  1474.     LA    R3,0
  1475.     LR    R4,R5
  1476.     ST    R7,SAVESCB
  1477.     L     R7,ASCB
  1478.     BAL   R14,SCRLUP   IF LAST LINE, SCROLL UP
  1479.     L     R7,SAVESCB
  1480.     AP    PCURLINE,=P'1'
  1481.     BAL   R14,KRINSWLB INSERT NEW LB AND UPDATE SCB
  1482.     B     KRINSEXT
  1483. KRINSASD EQU   *             SCROLL DOWN AND INSERT NEW ROW
  1484.     LA    R5,ROWINC(R5) MOVE TO NEXT ROW
  1485.     AP    PCURLINE,=P'1'
  1486.     LA    R7,LSCB(R7)
  1487.     BAL   R14,SCRLDOWN
  1488.     BAL   R14,KRINSWLB
  1489. KRINSEXT EQU   *
  1490.     LA    R6,0
  1491.     ZAP   PCOL,=P'1'
  1492.     CLI   HTMODE,TRUE
  1493.     BNE   KRSKPHT
  1494.     BAL   R14,KRHT     TAB
  1495. KRSKPHT  EQU   *
  1496.     BAL   R14,PUTPCT
  1497.     BAL   R14,SETCUR     RESET CURSOR ON NEW INSERTED LINE
  1498.     CLI   KBINS,INSSTATE IS INSERT ON
  1499.     BNE   KRSKPDN        NO, SKIP EXTRA DOWN
  1500.     CLC   LASTKEY,KEY    WAS LAST KEY ALSO CR TO INSERT
  1501.     BNE   KRSKPDN        YES, MOVE CURSOR DOWN TO PREV INSERT
  1502.     BAL   R14,KRDOWN
  1503. KRSKPDN  EQU   *
  1504.     BAL   R14,AUDITMS
  1505.     L     R14,KRCRSV14
  1506.     BR    R14
  1507.     TITLE 'KRINSWLB - CREATE NULL WLB AND UPDATE LB'S AND SCB'
  1508. KRINSWLB EQU   *
  1509.     ST    R14,INSCSV14
  1510.     MVC   WLBLINE,=AL1(ASCCR,ASCLF) SET TEXT TO NULL LINE
  1511.     MVC   SCBADDR,ANEWLB
  1512.     MVC   SCBLB,WLB     MOVE NEW LB INTO CURRENT SCB
  1513.     MVI   SCBCOL,0
  1514.     MVI   SCBMOD,FALSE
  1515.     L     R12,ANEWLB
  1516.     BAL   R14,CHKADDR
  1517.     MVC   LB(LLB),WLB         INIT NEW LB
  1518. KRINSWLN EQU   *
  1519.     L     R12,WLBNEXT
  1520.     LTR   R12,R12
  1521.     BZ    KRINSWLP
  1522.     BAL   R14,CHKADDR
  1523.     MVC   LBPREV,ANEWLB  CHAIN NEXT LB BACK TO NEW LB
  1524.     LA    R1,LSCB(R7)
  1525.     CL    R1,MAXSCB                 IS THERE A NEXT SCB
  1526.     BH    KRINSWLP
  1527.     MVC   SCBPREV-SCB(4,R1),ANEWLB  ALSO UPDATE NEXT SCB
  1528. KRINSWLP EQU   *
  1529.     L     R12,WLBPREV
  1530.     LTR   R12,R12
  1531.     BZ    KRINSWLE
  1532.     BAL   R14,CHKADDR
  1533.     MVC   LBNEXT,ANEWLB  CHAIN PREV LB TO NEW LB
  1534.     LR    R1,R7
  1535.     SH    R1,=AL2(LSCB)
  1536.     CL    R1,ASCB                  IS THERE A PREV SCB
  1537.     BL    KRINSWLE
  1538.     MVC   SCBNEXT-SCB(4,R1),ANEWLB ALSO UPDATE PREV SCB
  1539. KRINSWLE EQU   *
  1540.     L     R14,INSCSV14
  1541.     BR    R14
  1542.     TITLE 'SCRLDOWN - SCROLL SCREEN DOWN 1 LINE'
  1543. *
  1544. * SCROLL SCREEN DOWN FROM CURRENT ROW TO MAXROW
  1545. *
  1546. SCRLDOWN EQU   *
  1547.     ST    R14,SCRLSV14
  1548.     CL    R5,MAXROW   IS CURRENT ROW = LAST ROW
  1549.     BE    SCRLDWN1    YES, GO CLEAR LINE
  1550.     LA    R0,X'0701'  SCROLL DOWN 1 LINE
  1551.     LR    R14,R5      CX = STARTING ROW,COL
  1552.     L     R15,=A(SCRLEND) DX = ENDING   ROW,COL
  1553.     LA    R1,0
  1554.     ICM   R1,B'0010',ATTRIB
  1555.     SVC   VIDEO
  1556.     L     R1,MAXSCB
  1557.     B     SCRLDWNS
  1558. SCRLDWN1 EQU   *
  1559.     LR    R3,R5
  1560.     BAL   R14,CLRLINE
  1561. SCRLDWNS EQU   *
  1562.     CLC   LASTROW,MAXROW       IS LAST ROW ACTIVE
  1563.     BL    SCRLSKPU             NO, IGNORE
  1564.     CLI   SCBMOD-SCB(R1),TRUE  HAS IT CHANGED
  1565.     BNE   SCRLSKPU             NO, THROW AWAY
  1566.     L     R12,SCBADDR-SCB(R1)  YES, UPDATE MEMORY
  1567.     BAL   R14,CHKADDR
  1568.     MVC   LB(LLB),SCBLB-SCB(R1)  SAVE UPDATED LAST LINE
  1569. SCRLSKPU EQU   *
  1570.     L     R2,=A(22*ROWINC)   ROW BEING MOVED DOWN
  1571.     SH    R1,=AL2(LSCB)
  1572. SCRLSHFT EQU   *
  1573.     CR    R2,R5
  1574.     BL    SCRLUPLT
  1575.     MVC   LSCB(LSCB,R1),0(R1) MOVE SCB DOWN ONE
  1576.     SH    R1,=AL2(LSCB)
  1577.     SH    R2,=AL2(ROWINC)
  1578.     B     SCRLSHFT
  1579. SCRLUPLT EQU   *           UPDATE LAST ROW
  1580.     L     R1,LASTROW
  1581.     LA    R1,ROWINC(R1)
  1582.     CL    R1,MAXROW
  1583.     BH    SCRLEXIT
  1584.     ST    R1,LASTROW
  1585.     L     R1,LASTSCB
  1586.     LA    R1,LSCB(R1)
  1587.     ST    R1,LASTSCB
  1588. SCRLEXIT EQU   *
  1589.     L     R14,SCRLSV14
  1590.     BR    R14
  1591.     TITLE 'SCRLUP - SCROLL SCREEN UP 1 LINE'
  1592. *
  1593. *  R3 - STARTING ROW
  1594. *  R4 - ENDING ROW
  1595. *  R7 - STARTING SCB
  1596. *
  1597. SCRLUP   EQU   *
  1598.     ST    R14,SCRLSV14
  1599.     CLR   R3,R4       DON'T SCROLL 1 LINE
  1600.     BE    SCRLUP1
  1601.     LA    R0,X'0601'  SCROLL DOWN 1 LINE
  1602.     LA    R14,0(R3)   CX = STARTING ROW,COL
  1603.     LA    R15,79(R4)  DX = ENDING   ROW,COL
  1604.     LA    R1,0
  1605.     ICM   R1,B'0010',ATTRIB
  1606.     SVC   VIDEO
  1607.     B     SCRLUPSS
  1608. SCRLUP1  EQU   *
  1609.     BAL   R14,CLRLINE CLEAR ROW R3 ON SCREEN
  1610. SCRLUPSS EQU   *
  1611.     CLI   SCBMOD,TRUE  HAS IT CHANGED
  1612.     BNE   SCRLUPSK     NO, THROW AWAY
  1613.     L     R12,SCBADDR  YES, UPDATE MEMORY
  1614.     BAL   R14,CHKADDR
  1615.     MVC   LB(LLB),SCBLB  SAVE UPDATED FIRST LINE
  1616. SCRLUPSK EQU   *
  1617.     LA    R2,ROWINC(R3)  ROW BEING MOVED UP
  1618. SCRLUPSH EQU   *
  1619.     CR    R2,R4
  1620.     BH    SCRLUPEX
  1621.     MVC   0(LSCB,R7),LSCB(R7) MOVE SCB UP ONE
  1622.     LA    R7,LSCB(R7)
  1623.     LA    R2,ROWINC(R2)
  1624.     B     SCRLUPSH
  1625. SCRLUPEX EQU   *
  1626.     L     R14,SCRLSV14
  1627.     BR    R14
  1628.     TITLE 'CLRLINE - CLEAR ROW R3 ON SCREEN'
  1629. CLRLINE  EQU   *
  1630.     ST    R14,CLRLSV14
  1631.     LA    R0,X'0200'  AH=2 SET CURSOR
  1632.     LA    R1,0        BH=0 PAGE
  1633.     LR    R15,R3      DH=ROW,DL=COL
  1634.     SVC   VIDEO       SET CURSOR TO UPPER LEFT CORNER
  1635.     LA    R0,X'0920'  AH=10, AL=SPACE
  1636.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  1637.     IC    R1,ATTRIB
  1638.     LA    R14,80      CHARACTERS ON DATA LINES
  1639.     SVC   VIDEO       CLEAR DATA LINES
  1640.     L     R14,CLRLSV14
  1641.     BR    R14
  1642. KRHOME   EQU   *            HOME
  1643.     ST    R14,KRSV14
  1644.     MVC   GLBCUR,GLBFIRST
  1645.     ZAP   PCUR,=P'1'
  1646.     BAL   R14,DISPLAY
  1647.     L     R14,KRSV14
  1648.     BR    R14
  1649. KREND    EQU   *            END
  1650.     MVC   GLBCUR,GLBLAST
  1651.     ZAP   PCUR,PLSTLINE
  1652.     B     KRPGUP
  1653. KRSHF6   EQU   *            SHIFT F6 (DELETE LINE)
  1654.     ST    R14,KRSV14
  1655.     SP    PLSTLINE,=P'1'
  1656.     MVI   FILEMOD,TRUE
  1657.     L     R12,SCBADDR        ERR 8
  1658.     MVC   WLB(8),LB
  1659.     LA    R0,12              *************************
  1660.     LA    R1,WLB               VALIDATE SCB/LB MATCH
  1661.     LA    R2,SCBLB           *************************
  1662.     CLC   WLB(8),SCBLB
  1663.     BNE   AUDITBUG           SCB PREV/NEXT NE LB PREV/NEXT
  1664.     BAL   R14,CHKADDR
  1665.     MVC   LBNEXT,AFREELB    CHAIN FREE QUEUE TO LB
  1666.     ST    R12,AFREELB                 POINT TO DELETED LB
  1667.     L     R12,WLBPREV
  1668.     LTR   R12,R12
  1669.     BZ    KRSHF6F     GO UPDATE FIRST LB POINTER
  1670.     BAL   R14,CHKADDR
  1671.     MVC   LBNEXT,WLBNEXT    SET NEXT IN PREV. LB
  1672.     LTR   R5,R5
  1673.     BZ    KRSHF6N     GO UDATE PREV POINTER
  1674.     LR    R1,R7
  1675.     SH    R1,=AL2(LSCB)
  1676.     MVC   SCBNEXT-SCB(4,R1),WLBNEXT
  1677.     B     KRSHF6N
  1678. KRSHF6F  EQU   *
  1679.     MVC   GLBFIRST,WLBNEXT  UPDATE FIRST LB POINTER
  1680. KRSHF6N  EQU   *
  1681.     L     R12,WLBNEXT
  1682.     LTR   R12,R12
  1683.     BZ    KRSHF6L     IF LAST GO UPDATE LAST LB POINTER
  1684.     BAL   R14,CHKADDR
  1685.     MVC   LBPREV,WLBPREV   SET PREV IN NEXT LB
  1686.     CL    R5,MAXROW
  1687.     BNL   KRSHF6E
  1688.     LA    R1,LSCB(R7)
  1689.     MVC   SCBPREV-SCB(4,R1),WLBPREV
  1690.     B     KRSHF6E
  1691. KRSHF6L  EQU   *
  1692.     MVC   GLBLAST,WLBPREV   UPDATE LAST LB POINTER
  1693. KRSHF6E  EQU   *
  1694.     CLC   GLBCUR,SCBADDR  IS CURRENT LINE BEING DELETED
  1695.     BNE   KRSHF6EX        NO, EXIT
  1696.     MVC   GLBCUR,WLBNEXT  YES, TRY NEXT
  1697.     CLC   GLBCUR,=A(0)    IS NEXT NULL
  1698.     BNE   KRSHF6EX        NO, EXIT
  1699.     SP    PCUR,=P'1'
  1700.     MVC   GLBCUR,WLBPREV  YES, TRY PREV.
  1701.     CLC   GLBCUR,=A(0)    IS FILE NOW EMPTY
  1702.     BNE   KRSHF6ND        NO, GO DISPLAY PREV. LINE
  1703.     BAL   R14,NEWFILE     YES, CREATE NULL FILE
  1704. KRSHF6ND EQU   *
  1705.     BAL   R14,DISPLAY
  1706.     B     KRSHF6SC
  1707. KRSHF6EX EQU   *
  1708.     ST    R5,SAVEROW
  1709.     ST    R7,SAVESCB
  1710.     LR    R3,R5
  1711.     L     R4,MAXROW
  1712.     BAL   R14,SCRLUP      SCROLL SCREEN UP OVERLAYING DEL LINE
  1713.     LA    R6,0            RESET COLUMN
  1714.     ZAP   PCOL,=P'1'
  1715.     CLC   LASTSCB,MAXSCB  WAS LAST ROW ACTIVE
  1716.     BL    KRSHF6NL        NO, GO REDUCE LAST ROW POINTER
  1717.     L     R7,MAXSCB
  1718.     L     R12,SCBNEXT
  1719.     LTR   R12,R12         IS THERE NEW LINE FOR LAST ROW
  1720.     BZ    KRSHF6NL        NO, GO DECREMENT LAST ROW
  1721.     MVC   SCBLB(LLB),LB  MOVE IN NEW LAST LINE
  1722.     ST    R12,SCBADDR
  1723.     MVI   SCBMOD,FALSE
  1724.     SR    R3,R3
  1725.     L     R5,MAXROW
  1726.     BAL   R14,PUTLINE        DISPLAY NEW LAST LINE
  1727.     B     KRSHF6XT
  1728. KRSHF6NL EQU   *               UPDATE NEW LAST ROW
  1729.     L     R5,LASTROW
  1730.     L     R7,LASTSCB
  1731.     SH    R5,=AL2(ROWINC)
  1732.     SH    R7,=AL2(LSCB)
  1733.     ST    R5,LASTROW
  1734.     ST    R7,LASTSCB
  1735. KRSHF6XT EQU   *
  1736.     L     R5,SAVEROW
  1737.     L     R7,SAVESCB
  1738.     CL    R5,LASTROW
  1739.     BNH   KRSHF6SC
  1740.     SP    PCURLINE,=P'1'
  1741.     L     R5,LASTROW
  1742.     L     R7,LASTSCB
  1743. KRSHF6SC EQU   *
  1744.     BAL   R14,AUDITMS
  1745.     BAL   R14,PUTPCT
  1746.     BAL   R14,SETCUR
  1747.     L     R14,KRSV14
  1748.     BR    R14
  1749. KRF3     EQU   *            F3 (START OF LINE)
  1750.     ST    R14,KRSV14
  1751.     LA    R6,0
  1752.     ZAP   PCOL,=P'1'
  1753.     BAL   R14,SETCUR
  1754.     L     R14,KRSV14
  1755.     BR    R14
  1756. KRF4     EQU   *            F4 (END OF LINE)
  1757.     ST    R14,KRSV14
  1758.     IC    R6,SCBCOL
  1759.     CH    R6,=AL2(79)
  1760.     BNH   KRF4SKPL
  1761.     BCTR  R6,0
  1762. KRF4SKPL EQU   *
  1763.     CVD   R6,PWORK
  1764.     ZAP   PCOL,PWORK
  1765.     AP    PCOL,=P'1'
  1766.     BAL   R14,SETCUR
  1767.     L     R14,KRSV14
  1768.     BR    R14
  1769. KRF5     EQU   *            F5 (LABEL BLOCK)
  1770.     ST    R14,KRSV14
  1771.     CLI   BLKLABEL,FALSE
  1772.     BE    KRF5MARK       IF FALSE, SET MARK
  1773.     CLI   BLKLABEL,MARK  IF MARK,  SET TRUE
  1774.     BE    KRF5TRUE
  1775.     MVI   BLKLABEL,FALSE ELSE, TURN BLOCK LABEL BACK OFF
  1776.     MVC   STATBLK,=C'   '
  1777.     LA    R3,STATBLK
  1778.     LA    R4,L'STATBLK
  1779.     BAL   R14,PUTSTAT
  1780.     BAL   R14,DISPLAY    REMOVE MARKED LINES FROM SCREEN
  1781. KRF5EXIT EQU   *
  1782.     L     R14,KRSV14
  1783.     BR    R14
  1784. KRF5MARK EQU   *
  1785.     LA    R1,=CL20'MARKING BLOCK'
  1786.     BAL   R14,PUTMSG
  1787.     MVI   BOX,FALSE       TURN OFF BOX GRAPHICS
  1788.     MVI   BLKLABEL,MARK
  1789.     MVC   STATBLK,=C'BLK'
  1790.     LA    R3,STATBLK
  1791.     LA    R4,L'STATBLK
  1792.     BAL   R14,PUTSTAT
  1793.     BAL   R14,CHKMARK
  1794.     MVC   BLK1LB,SCBADDR
  1795.     ZAP   PCURBLK1,PCURLINE
  1796.     B     KRF5EXIT
  1797. KRF5TRUE EQU   *
  1798.     LA    R1,=CL20'POSITIONING BLOCK'
  1799.     BAL   R14,PUTMSG
  1800.     MVI   BLKLABEL,TRUE
  1801.     MVC   BLK2LB,SCBADDR
  1802.     B     KRF5EXIT
  1803. KRF6     EQU   *            F6 (DUPLICATE BLOCK)
  1804.     ST    R14,KRSV14
  1805.     CLI   BLKLABEL,TRUE
  1806.     BNE   KRF6NOTD     NO DUP IF NO BLOCK DEFINED CURRENTLY
  1807.     MVC   PREVDUP,SCBPREV
  1808.     L     R12,BLK1LB
  1809. KRF6L1   EQU   *            CHECK IF CHAINED LB IN BLOCK
  1810.     CL    R12,BLK2LB
  1811.     BE    KRF6OK       OK, GO DUPLICATE
  1812.     CL    R12,PREVDUP
  1813.     BE    KRF6NOTD     NO DUP IF INSIDE BLOCK
  1814.     MVC   WLBNEXT,LBNEXT GET NEXT LB TO DUP.
  1815.     L     R12,WLBNEXT
  1816.     LTR   R12,R12
  1817.     BNZ   KRF6L1
  1818. KRF6NOTD EQU   *            NO DUP DUE TO NO BLK OR INSIDE BLK
  1819.     LA    R1,=CL20'NO DUP - INV. REQ.'
  1820.     BAL   R14,PUTMSG
  1821.     L     R14,KRSV14
  1822.     BR    R14
  1823. KRF6OK   EQU   *            OK TO DUPLICATE
  1824.     LA    R1,=CL20'DUPLICATING BLOCK'
  1825.     BAL   R14,PUTMSG
  1826.     MVC   STATBLK,=C'   '
  1827.     LA    R3,STATBLK
  1828.     LA    R4,L'STATBLK
  1829.     BAL   R14,PUTSTAT
  1830.     MVI   BLKLABEL,FALSE    TURN OFF BLOCK
  1831.     MVI   FILEMOD,TRUE      SET FILE CHANGE
  1832.     BAL   R14,UPDATE        UPDATE MS FROM SCREEN BEFORE COPY
  1833.     MVC   SAVENEXT,SCBADDR  SAVE NEXT TO STORE IN LAST
  1834.     MVC   NEXTBLK,BLK1LB
  1835. KRF6DUP  EQU   *
  1836.     BAL   R14,GETNEWLB
  1837.     LTR   R15,R15
  1838.     BNZ   KRF6LAST     IF NO MORE LB'S, GO FINISH LAST LB
  1839.     AP    PLSTLINE,=P'1'
  1840.     LTR   R5,R5
  1841.     BNZ   KRF6SKPC       IF INSERTING BEFORE FIRST LINE,
  1842.     AP    PCUR,=P'1'     INCR CURRENT LINE COUNTERS
  1843.     AP    PCURLINE,=P'1'
  1844. KRF6SKPC EQU   *
  1845.     L     R12,NEXTBLK
  1846.     MVC   WLB(LLB),LB   GET FIRST LB TO DUP
  1847.     MVC   WLBPREV,PREVDUP
  1848.     L     R12,ANEWLB
  1849.     BAL   R14,CHKADDR
  1850.     MVC   LB(LLB),WLB   COPY TO NEW LB
  1851.     L     R12,WLBPREV
  1852.     LTR   R12,R12
  1853.     BNZ   KRF6DUPP
  1854.     MVC   GLBFIRST,ANEWLB     RESET FIRST LB
  1855.     B     KRF6DUPN
  1856. KRF6DUPP EQU   *                   CHAIN PREVIOUS
  1857.     BAL   R14,CHKADDR
  1858.     MVC   LBNEXT,ANEWLB  SET NEXT IN PREV LB
  1859. KRF6DUPN EQU   *
  1860.     MVC   PREVDUP,ANEWLB
  1861.     L     R12,NEXTBLK
  1862.     CL    R12,BLK2LB       IS THIS LAST BLOCK
  1863.     BE    KRF6LAST         YES, GO SET NEXT POINTER
  1864.     MVC   NEXTBLK,LBNEXT  NEXT BLOCK TO DUP
  1865.     B     KRF6DUP
  1866. KRF6LAST EQU   *
  1867.     L     R12,PREVDUP
  1868.     BAL   R14,CHKADDR
  1869.     MVC   LBNEXT,SAVENEXT   SET NEXT IN LAST LB
  1870.     L     R12,SAVENEXT
  1871.     BAL   R14,CHKADDR
  1872.     MVC   LBPREV,PREVDUP    SET PREV IN NEXT LB
  1873.     BAL   R14,AUDITMS
  1874.     BAL   R14,PUTPCT
  1875.     BAL   R14,DISPLAY
  1876.     L     R14,KRSV14
  1877.     BR    R14
  1878. KRF7     EQU   *            F7 (SEARCH)
  1879.     ST    R14,KRSV14
  1880.     LA    R1,=CL20'KEY='
  1881.     BAL   R14,PUTMSG
  1882.     LA    R1,4         SET STARTING COL IN STATMSG
  1883.     BAL   R14,GETWORD  GET SEARCH KEY
  1884.     CLI   LWORD,L'WORD
  1885.     BNL   KRF7ABT2     EXIT NOW IF LENGTH ZERO OR ABORTED
  1886.     MVC   LKEYWORD,LWORD
  1887.     MVC   KEYWORD,WORD
  1888.     XC    FINDKEY,FINDKEY     CLEAR TRT TABLE
  1889.     MVI   FINDKEY+ASCLF,ASCLF SET END OF RECORD TRAP
  1890.     SR    R1,R1
  1891.     IC    R1,KEYWORD
  1892.     STC   R1,FINDKEY(R1)      SET TRAP FOR FIRST CHAR.
  1893.     LA    R6,20
  1894.     BAL   R14,SETCUR
  1895.     LA    R1,=CL20'REPLACE Y/N/G (CR=N)'
  1896.     BAL   R14,PUTMSG
  1897.     BAL   R14,GETKEY
  1898.     MVC   WLBNEXT,SCBADDR
  1899.     MVC   PCURSRCH,PCURLINE
  1900.     SP    PCURSRCH,=P'1'
  1901.     MVI   REPLACE,FALSE       ASSUME NO REPLACE
  1902.     MVI   GLOBAL,FALSE        ASSUME NO GLOBAL REPLACE
  1903.     OI    KEY,X'20'
  1904.     CLI   KEY,X'79'     IS THIS A Y
  1905.     BE    KRF7REP       YES, GO GET REPLACE WORD
  1906.     CLI   KEY,X'67'     IS THIS A G (GLOBAL SERACH AND REPLACE)
  1907.     BNE   KRF7STRT      NO, GO SEARCH ONLY
  1908.     MVI   GLOBAL,TRUE   YES, SET GLOBAL REPLACE
  1909. KRF7REP  EQU   *
  1910.     LA    R1,=CL20'REP='
  1911.     BAL   R14,PUTMSG
  1912.     LA    R1,4
  1913.     BAL   R14,GETWORD     GET REPLACE WORD IN WORD
  1914.     CLI   LWORD,X'AB'
  1915.     BE    KRF7ABT2        EXIT IF GETWORD ABORT
  1916.     MVC   LREPWORD,LWORD
  1917.     MVC   REPWORD,WORD    SAVE IN REPWORD
  1918.     MVI   REPLACE,TRUE    SET REPLACE MODE
  1919. KRF7STRT EQU   *
  1920.     BAL   R14,UPDATE      UPDATE FROM SCREEN BEFORE SEARCH
  1921.     LA    R1,=CL20'SEARCHING'
  1922.     CLI   REPLACE,TRUE
  1923.     BNE   KRF7SRCH
  1924.     LA    R1,=CL20'REPLACING'
  1925. KRF7SRCH EQU   *
  1926.     BAL   R14,PUTMSG
  1927.     LA    R7,100
  1928. KRF7NXTL EQU   *               START SEARCH OF NEXT LINE
  1929.     L     R12,WLBNEXT
  1930.     LTR   R12,R12
  1931.     BZ    KRF7NOTF        EXIT IF NOT FOUND
  1932.     AP    PCURSRCH,=P'1'
  1933.     MVC   WLB(LLB),LB   MOVE NEXT LB TO WLB
  1934.     SR    R3,R3
  1935.     LA    R1,WLBLINE
  1936.     BCT   R7,KRF7NXTC
  1937.     LA    R0,X'0100'
  1938.     SVC   KEYBOARD
  1939.     STCM  R0,4,PWORK      STORE LOW FLAGS
  1940.     TM    PWORK,X'40'     IS THERE A KEY WAITING
  1941.     BZ    KRF7ABT1        YES, ABORT NOT FOUND
  1942.     LA    R7,100
  1943.     MVC   STATREC,=X'402020202020' UPDATE LINE BEING SEARCHED
  1944.     ED    STATREC,PCURSRCH
  1945.     ZAP   PCURLINE,PCURSRCH
  1946.     LA    R3,STATREC
  1947.     LA    R4,L'STATREC
  1948.     BAL   R14,PUTSTAT
  1949.     SR    R3,R3
  1950.     LA    R1,WLBLINE
  1951. KRF7NXTC EQU   *               SEARCH TO NEXT MATCHING FIRST CHAR.
  1952.     TRT   0(L'WLBLINE,R1),FINDKEY FIRST CHAR. FOUND
  1953.     CLM   R2,1,=AL1(ASCLF) IS THIS END OF RECORD
  1954.     BE    KRF7NXTL        YES, NEXT LINE
  1955.     IC    R3,LKEYWORD
  1956.     EX    R3,CLCKEYW      DOES ENTIRE KEYWORD MATCH
  1957.     BE    KRF7HIT         YES, EXIT WITH MATCHING LINE AT TOP
  1958.     LA    R1,1(R1)        NO,  SKIP MATCHING CHARACTER
  1959.     B     KRF7NXTC        REPEAT SEARCH TO END OF LINE
  1960. KRF7HIT  EQU   *               KEY FOUND
  1961.     ST    R12,GLBCUR      MOVE LINE TO TOP OF SCREEN
  1962.     MVC   PCUR,PCURSRCH
  1963.     CLI   REPLACE,TRUE
  1964.     BNE   KRF7EXIT
  1965.     MVI   FILEMOD,TRUE    RELEASE 1.4 FIX  ****************
  1966.     LA    R4,1(R1,R3)     R4=A(TEXT BEYOND KEY IN WLBLINE)
  1967.     MVC   SAVETEXT,0(R4)
  1968.     LA    R2,WLBLINE+L'WLBLINE-2
  1969.     SR    R2,R1           R2 = L'REMAINING TEXT IN WLBLINE-2
  1970.     LR    R4,R1           ASSUME NO REP
  1971.     CLI   LREPWORD,X'FF'  IS THERE ANY REP
  1972.     BE    KRF7MTXT        NO, GO OVERLAY KEY WTTH TEXT
  1973.     IC    R3,LREPWORD
  1974.     SR    R2,R3           R2 = L'TEXT BEYOND REP IN WLBLINE-1
  1975.     BM    KRF7HITE        DON'T REPLACE IF IT WON'T FIT
  1976.     EX    R3,MVCREP       MOVE REP OVER KEY
  1977.     LA    R4,1(R1,R3)     R4 = A(TEXT BEYOND REP)
  1978. KRF7MTXT EQU   *
  1979.     EX    R2,MVCTXT       MOVE REMAINING TEXT BEHIND REP
  1980.     BAL   R14,CHKADDR
  1981.     MVC   LB(LLB),WLB UPDATE LB WITH REPLACEMENT
  1982. KRF7HITE EQU   *
  1983.     CLI   GLOBAL,TRUE
  1984.     BNE   KRF7EXIT
  1985.     LA    R1,1(R1)
  1986.     B     KRF7NXTC
  1987. KRF7ABT1 EQU   *
  1988.     LA    R0,X'0000'     FLUSH INTERRUPT KEY
  1989.     SVC   KEYBOARD
  1990. KRF7ABT2 EQU   *
  1991.     LA    R1,=CL20'ABORT SEARCH'
  1992.     BAL   R14,PUTMSG
  1993.     B     KRF7EXIT
  1994. KRF7NOTF EQU   *
  1995.     LA    R1,=CL20'NOT FOUND'
  1996.     BAL   R14,PUTMSG
  1997. KRF7EXIT EQU   *
  1998.     BAL   R14,AUDITMS
  1999.     BAL   R14,DISPLAY
  2000.     L     R14,KRSV14
  2001.     BR    R14
  2002. CLCKEYW  CLC   0(0,R1),KEYWORD  COMPARE ENTIRE KEYWORD
  2003. MVCREP   MVC   0(0,R1),REPWORD  MOVE REP OVERLAYING KEY
  2004. MVCTXT   MVC   0(0,R4),SAVETEXT MOVE REMAINING TEXT BEHIND REP
  2005.     TITLE 'GETWORD - READ STRING FROM KEYBOARD WORD'
  2006. *
  2007. *        R1 = STARTING COL IN STATMSG
  2008. *        LWORD = LENGTH - 1 OR X'FF' IF NONE OR X'AB' IF ABORTED
  2009. *
  2010. GETWORD  EQU   *
  2011.     ST    R14,GETWSV14
  2012.     ST    R5,SAVEROW
  2013.     ST    R6,SAVECOL
  2014.     LR    R6,R1
  2015.     BAL   R14,SETCUR   UPDATE LINE AND COL BEFORE CHANGING
  2016.     L     R5,STATROW
  2017.     LA    R3,WORD
  2018.     LA    R4,L'WORD
  2019. GETWLOOP EQU   *
  2020.     STM   R3,R4,GETWSV34
  2021.     BAL   R14,SETCUR
  2022.     LA    R0,X'0920'  AH=9, AL= ASCII BLANK
  2023.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.
  2024.     IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.
  2025.     LA    R14,1       CX=(COUNT OF CHAR TO WRITE)
  2026.     SVC   VIDEO       DISPLAY BLANK AT CURSOR
  2027.     BAL   R14,GETKEY
  2028.     LM    R3,R4,GETWSV34
  2029.     CLI   KEY,ASCBS
  2030.     BNE   GETWCHKA
  2031.     CL    R3,=A(WORD)
  2032.     BNH   GETWLOOP     IGNORE BS IF AT BEGINNING
  2033.     BCTR  R3,0
  2034.     LA    R4,1(R4)
  2035.     BCTR  R6,0
  2036.     B     GETWLOOP
  2037. GETWCHKA EQU   *
  2038.     CLI   KEY,ASCCR
  2039.     BE    GETWOK
  2040.     CLI   KEY,X'20'
  2041.     BL    GETWQUIT
  2042.     CLI   KEY,X'80'
  2043.     BNL   GETWQUIT
  2044.     LA    R1,STATMSG(R6)
  2045.     MVC   0(1,R1),KEY
  2046.     LA    R0,X'0900'  AH=9
  2047.     LA    R1,X'0000'  BH=0 PAGE,BL=ATTRIB.(WHITE ON BLUE)
  2048.     IC    R1,ATTRIB   BL=ATRIBUTE OF CHAR.
  2049.     LA    R14,1       CX=(COUNT CHAR)
  2050.     IC    R0,KEY      AL=CHAR
  2051.     SVC   VIDEO       DISPLAY CHAR
  2052.     LA    R6,1(R6)
  2053.     MVC   0(1,R3),KEY
  2054.     LA    R3,1(R3)
  2055.     BCT   R4,GETWLOOP
  2056. GETWQUIT EQU   *
  2057.     MVI   LWORD,X'AB'
  2058.     B     GETWEXIT
  2059. GETWOK   EQU   *
  2060.     LA    R3,L'WORD-1
  2061.     SR    R3,R4
  2062.     STC   R3,LWORD        SAVE LENGTH (X'FF' = NO CHAR)
  2063. GETWEXIT EQU   *
  2064.     L     R5,SAVEROW
  2065.     L     R6,SAVECOL
  2066.     BAL   R14,SETCUR
  2067.     L     R14,GETWSV14
  2068.     BR    R14
  2069. KRF8     EQU   *            REPEAT F7 SEARCH
  2070.     ST    R14,KRSV14
  2071.     MVC   WLBNEXT,SCBNEXT
  2072.     ZAP   PCURSRCH,PCURLINE
  2073.     B     KRF7STRT
  2074. KRF9     EQU   *            SELECT COLOR
  2075.     ST    R14,KRSV14
  2076.     SR    R1,R1
  2077.     IC    R1,ATTRIB
  2078.     LR    R2,R1
  2079.     N     R1,=X'000000F0' R1 = LEFT NIBBLE * 16
  2080.     N     R2,=X'0000000F' R2 = RIGHT NIBBLE
  2081.     ST    R5,SAVEROW
  2082.     ST    R6,SAVECOL
  2083.     LA    R6,15
  2084. KRF9LOOP EQU   *
  2085.     LA    R0,0(R1,R2)
  2086.     STC   R0,ATTRIB        UPDATE ATTRIB
  2087.     STM   R1,R2,KRF9SV12   SAVE R1-R2 ACROSS I/O
  2088.     MVC   STATMSG,=CL20'COLOR BRGBIRGB'
  2089.     BAL   R14,DHEXATT
  2090.     LA    R3,STATMSG
  2091.     LA    R4,L'STATMSG
  2092.     BAL   R14,PUTSTAT
  2093.     L     R5,STATROW
  2094.     LA    R15,0(R5,R6)
  2095.     LA    R0,X'0200'      AH=2 SET CURSOR
  2096.     LA    R1,0            BH=0 PAGE
  2097.     SVC   VIDEO
  2098.     L     R5,SAVEROW
  2099.     BAL   R14,GETKEY       GET NEXT KEY (CR,ARROWS,0-9,A-F)
  2100.     LM    R1,R2,KRF9SV12
  2101.     CLI   KEY,ASCCR        CR TO EXIT F9 WITH CURRENT ATTRIB
  2102.     BE    KRF9EXIT
  2103.     CLI   KEY,ASCUP        UP ARROW TO INCR CURRENT NIBBLE
  2104.     BNE   KRF9CKDN
  2105. KRF9UP   EQU   *
  2106.     CLM   R6,1,=AL1(15)
  2107.     BNE   KRF9UP2
  2108.     LA    R1,16(R1)
  2109.     N     R1,=X'000000F0'
  2110.     B     KRF9LOOP
  2111. KRF9UP2  EQU   *
  2112.     LA    R2,1(R2)
  2113.     N     R2,=X'0000000F'
  2114.     B     KRF9LOOP
  2115. KRF9CKDN EQU   *
  2116.     CLI   KEY,ASCDOWN    DOWN ARROW TO DEC CURRENT NIBBLE
  2117.     BNE   KRF9CHLF
  2118.     CLM   R6,1,=AL1(15)
  2119.     BNE   KRF9DN2
  2120.     SH    R1,=H'16'
  2121.     N     R1,=X'000000F0'
  2122.     B     KRF9LOOP
  2123. KRF9DN2  EQU   *
  2124.     BCTR  R2,0
  2125.     N     R2,=X'0000000F'
  2126.     B     KRF9LOOP
  2127. KRF9CHLF EQU   *
  2128.     CLI   KEY,ASCLEFT    LEFT ARROW TO SELECT LEFT NIBBLE
  2129.     BNE   KRF9CHRG
  2130.     LA    R6,15
  2131.     B     KRF9LOOP
  2132. KRF9CHRG EQU   *
  2133.     CLI   KEY,ASCRGHT    RIGHT ARROW TO SELECT RIGHT NIBBLE
  2134.     BNE   KRF9HEX
  2135.     LA    R6,16
  2136.     B     KRF9LOOP
  2137. KRF9HEX  EQU   *
  2138.     CLI   KEY,X'80'
  2139.     BNL   KRF9LOOP
  2140.     TR    KEY,HEXTAB     CONVERT ASCII KEY TO 0-F OR FF
  2141.     CLI   KEY,X'FF'
  2142.     BE    KRF9LOOP       IGNORE INVALID CHAR.
  2143.     SR    R0,R0
  2144.     IC    R0,KEY
  2145.     CLM   R6,1,=AL1(15)
  2146.     BNE   KRF9HEX2
  2147.     SLL   R0,4
  2148.     LR    R1,R0          SET LEFT NIBBLE
  2149.     LA    R6,16          SWITCH NIBBLE
  2150.     B     KRF9LOOP
  2151. KRF9HEX2 EQU   *
  2152.     LR    R2,R0          SET RIGHT NIBBLE
  2153.     LA    R6,15          SWITCH NIBBLE
  2154.     B     KRF9LOOP
  2155. KRF9EXIT EQU   *
  2156.     LA    R0,X'0B00'     AH=11 FOR SET COLOR PALETTE (TECH. A-49)
  2157.     SR    R1,R1
  2158.     IC    R1,ATTRIB
  2159.     SRL   R1,4
  2160.     N     R1,=X'00000007' SET BACKGROUND T SAME AS ATTRIB
  2161.     SVC   VIDEO
  2162.     BAL   R14,NEWSTAT     REFRESH STATUS LINE WITH NEW ATTRIBUTE
  2163.     L     R5,SAVEROW
  2164.     L     R6,SAVECOL
  2165.     BAL   R14,SETCUR
  2166.     L     R14,KRSV14
  2167.     BR    R14
  2168. DHEXATT  EQU   *            DISPLAY ATTRIBUTE IN HEX
  2169.     SR    R1,R1
  2170.     IC    R1,ATTRIB
  2171.     SRL   R1,4
  2172.     IC    R1,HEX(R1)
  2173.     STC   R1,STATMSG+15
  2174.     IC    R1,ATTRIB
  2175.     N     R1,=X'0000000F'
  2176.     IC    R1,HEX(R1)
  2177.     STC   R1,STATMSG+16
  2178.     BR    R14
  2179. KRF10    EQU   *            BOX GRAPHICS
  2180.     ST    R14,KR10SV14
  2181.     CLI   BOX,TRUE     IF BOX MODE ON, TURN IT OFF
  2182.     BE    KRF10OFF     ELSE TURN IT ON
  2183.     MVI   BOX,TRUE
  2184.     MVI   BLKLABEL,FALSE    TURN OFF BLOCK MODE
  2185.     MVC   STATBLK,=C'BOX'   DISPLAY BOX MODE USING BLK IND.
  2186.     LA    R3,STATBLK
  2187.     LA    R4,L'STATBLK
  2188.     BAL   R14,PUTSTAT
  2189.     CLI   KBINS,INSSTATE    IF INSERT MODE ON, TURN IT OFF
  2190.     BNE   KRF10EXT
  2191.     BAL   R14,KRINS
  2192.     B     KRF10EXT
  2193. KRF10OFF EQU   *
  2194.     MVI   BOX,FALSE
  2195.     MVC   STATBLK,=C'   '
  2196.     LA    R3,STATBLK
  2197.     LA    R4,L'STATBLK
  2198.     BAL   R14,PUTSTAT
  2199. KRF10EXT EQU   *
  2200.     L     R14,KR10SV14
  2201.     BR    R14
  2202. KRSHF1   EQU   *            SHIFT F1 (QUICK SAVE)
  2203.     ST    R14,KRSV14
  2204.     BAL   R14,SAVEFILE  SAVE FILE NOW AND RESET FILEMOD
  2205.     L     R14,KRSV14
  2206.     BR    R14
  2207. KRSHF10  EQU   *            SWITCH BOX GRAPHIC CHARACTER SET
  2208.     ST    R14,KRSV14
  2209.     L     R1,BOXSETA   ADDRESS OF BOX GRAPHIC CHARACTERS
  2210.     CLI   CONNECT,TRUE
  2211.     BE    KRSHF10A     GO TOGGLE SET1/SET2 IN CONNECT MODE
  2212.     LA    R1,8(R1)     INCR TO NEXT SET
  2213.     CL    R1,=A(BOXSETE) IS THIS END OF TABLE
  2214.     BL    KRSHF10S
  2215.     LA    R1,BOXSET    YES, RESET TO FIRST SET
  2216.     B     KRSHF10S
  2217. KRSHF10A EQU   *
  2218.     CL    R1,=A(BOXSET1)  IF SET1, SWITCH TO SET 2
  2219.     BE    KRSHF102
  2220. KRSHF101 EQU   *
  2221.     LA    R1,BOXSET1
  2222.     B     KRSHF10S
  2223. KRSHF102 EQU   *
  2224.     LA    R1,BOXSET2
  2225. KRSHF10S EQU   *
  2226.     ST    R1,BOXSETA   UPDATE BOX SET POINTER
  2227. KRPRTSET EQU   *
  2228.     LA    R1,=CL20'BOX CHAR = '
  2229.     BAL   R14,PUTMSG
  2230.     L     R1,BOXSETA
  2231.     MVC   STATMSG+11(8),0(R1)
  2232.     MVI   STATMSG+19,X'00'
  2233.     SR    R1,R1
  2234.     IC    R1,ATTRIB
  2235.     LA    R2,STATMSG+11
  2236.     L     R15,STATROW
  2237.     LA    R15,11(R15)
  2238.     SVC   PRINTTXT      PRINT GRAPHIC BOX CHARACTERS
  2239.     L     R14,KRSV14
  2240.     BR    R14
  2241. KRALTF10 EQU   *             TOGGLE CONNECT MODE
  2242.     ST    R14,KRSV14
  2243.     CLI   CONNECT,TRUE
  2244.     BE    KRAF10R
  2245.     MVI   CONNECT,TRUE        SET CONNECT ON WITH SINGLE LINE
  2246.     MVC   BOXSETA,=A(BOXSET1)
  2247.     LA    R1,=CL20'CONNECT MODE SET'
  2248.     BAL   R14,PUTMSG
  2249.     L     R14,KRSV14
  2250.     BR    R14
  2251. KRAF10R  EQU   *
  2252.     MVI   CONNECT,FALSE
  2253.     LA    R1,=CL20'CONNECT MODE OFF'
  2254.     BAL   R14,PUTMSG
  2255.     L     R14,KRSV14
  2256.     BR    R14
  2257. KRALTF1  EQU   *             ALT-F1 PAUSE UNTIL KEY HIT
  2258.     ST    R14,KRWTSV14
  2259.     CLI   KSMODE,KSREAD
  2260.     BE    KRAF1GET
  2261.     LA    R1,=CL20'PAUSE'
  2262.     BAL   R14,PUTMSG
  2263.     B     KRALTEXT
  2264. KRAF1GET EQU   *
  2265.     LA    R1,=CL20'PAUSE - PRESS ENTER'
  2266.     BAL   R14,PUTMSG
  2267.     LA    R0,X'0000'
  2268.     SVC   KEYBOARD      READ NEXT KEY AND IGNORE
  2269. KRALTEXT EQU   *
  2270.     L     R14,KRWTSV14
  2271.     BR    R14
  2272. KRALTF2  EQU   *             ALT-F2 WAIT A SECOND
  2273.     ST    R14,KRWTSV14
  2274.     LA    R1,=CL20'WAIT A SECOND'
  2275.     BAL   R14,PUTMSG
  2276.     CLI   KSMODE,KSREAD
  2277.     BNE   KRALTEXT
  2278.     L     R1,=A(3000)   SET WAIT LOOP COUNT
  2279. KRALTF2L EQU   *
  2280.     BCT   R1,KRALTF2L
  2281.     L     R14,KRWTSV14
  2282.     BR    R14
  2283. KRALTF3  EQU   *            ENTER DEBUG MODE
  2284.     ST    R14,KRSV14
  2285.     SVC   TRACE
  2286.     DC    C'BUG '
  2287.     BAL   R14,NEWSTAT  CLEAN UP SCREEN AFTER DEBUG
  2288.     BAL   R14,DISPLAY
  2289.     L     R14,KRSV14
  2290.     BR    R14
  2291. KRALTF4  EQU   *            TOGGLE AUDIT MODE
  2292.     ST    R14,KRSV14
  2293.     XI    AUDIT,TRUE
  2294.     CLI   AUDIT,TRUE
  2295.     LA    R1,=CL20'AUDIT MODE ON'
  2296.     BE    KRAF4MSG
  2297.     LA    R1,=CL20'AUDIT MODE OFF'
  2298. KRAF4MSG EQU   *
  2299.     BAL   R14,PUTMSG
  2300.     L     R14,KRSV14
  2301.     BR    R14
  2302. KRALTF5  EQU   *            GOTO LINE #
  2303.     ST    R14,KRSV14
  2304.     LA    R1,=CL20'LINE='
  2305.     BAL   R14,PUTMSG
  2306.     LA    R1,5
  2307.     BAL   R14,GETWORD
  2308.     CLI   LWORD,L'WORD
  2309.     BNL   KRA5ERR         IF LENGTH 0, IGNORE
  2310.     SR    R1,R1
  2311.     IC    R1,LWORD
  2312.     EX    R1,TRTWORD
  2313.     BNZ   KRA5ERR         IF NOT ASCII NUMERIC, IGNORE
  2314.     EX    R1,PCKWORD
  2315.     OI    PWORD+L'PWORD-1,X'0F' CONVERT ASCII DIGIT SIGN
  2316.     CP    PWORD,PLSTLINE  IF PAST END, IGNORE
  2317.     BH    KRA5ERR
  2318.     CP    PWORD,=P'1'
  2319.     BL    KRA5ERR         IF NOT GE 1, IGNORE
  2320.     CP    PWORD,PCUR
  2321.     BL    KRA5LOW         LINE IS BELOW CURRENT LINE
  2322.     ZAP   PWORK,PLSTLINE
  2323.     SP    PWORK,PWORD     PWORK IS DISTANCE FROM END
  2324.     ZAP   PWORK1,PWORD
  2325.     SP    PWORK1,PCUR     PWORK1 IS DISTANCE FROM CUR
  2326.     CP    PWORK,PWORK1    IS IT SHORTER VIA PCUR OR PLSTLINE
  2327.     BH    KRA5FWD         GO FORWARD FROM CURRENT POS.
  2328.     ZAP   PCUR,PLSTLINE
  2329.     MVC   GLBCUR,GLBLAST
  2330.     B     KRA5BAK          GO BACKWORD FROM END
  2331. TRTWORD  TRT   WORD(0),NUMERIC  TEST WORD FOR NUMERIC LINE #
  2332. PCKWORD  PACK  PWORD,WORD(0)    PACK WORD
  2333. KRA5LOW  EQU   *
  2334.     ZAP   PWORK,PCUR
  2335.     SP    PWORK,PWORD PWORK IS DISTANCE FROM CUR
  2336.     CP    PWORK,PWORD IS IT SHORTER FROM START OR CUR
  2337.     BL    KRA5BAK     GO BACKWARD FROM CUR
  2338.     ZAP   PCUR,=P'1'
  2339.     MVC   GLBCUR,GLBFIRST
  2340. KRA5FWD  EQU   *           GO FORWARD FROM PCUR TO PWORD
  2341.     CP    PCUR,PWORD
  2342.     BE    KRA5EXIT
  2343.     L     R12,GLBCUR
  2344.     MVC   WLBNEXT,LBNEXT
  2345.     CLC   WLBNEXT,=A(0)
  2346.     BE    KRA5ERR      ERROR IF EOF FOUND
  2347.     AP    PCUR,=P'1'
  2348.     MVC   GLBCUR,WLBNEXT
  2349.     B     KRA5FWD
  2350. KRA5BAK  EQU   *           GO BACKWARD FROM PCUR TO PWORD
  2351.     CP    PCUR,PWORD
  2352.     BE    KRA5EXIT
  2353.     L     R12,GLBCUR
  2354.     MVC   WLBPREV,LBPREV
  2355.     CLC   WLBPREV,=A(0)
  2356.     BE    KRA5ERR      ERROR IF EOF FOUND
  2357.     SP    PCUR,=P'1'
  2358.     MVC   GLBCUR,WLBPREV
  2359.     B     KRA5BAK
  2360. KRA5ERR  EQU   *
  2361.     LA    R1,=CL20'INVALID LINE #'
  2362.     BAL   R14,PUTMSG
  2363. KRA5EXIT EQU   *
  2364.     BAL   R14,DISPLAY
  2365.     L     R14,KRSV14
  2366.     BR    R14
  2367. KRBS     EQU   *            BACK SPACE
  2368.     ST    R14,KRSV14
  2369.     LTR   R6,R6
  2370.     BZ    KRDELCHR
  2371.     BCTR  R6,0
  2372.     SP    PCOL,=P'1'
  2373.     BAL   R14,SETCUR
  2374.     L     R14,KRSV14
  2375.     B     KRDELCHR
  2376. KRHT     EQU   *            HORIZONTAL TAB
  2377.     ST    R14,KRSV14
  2378.     CH    R6,=H'9'
  2379.     BL    KRHTC10
  2380.     CH    R6,=H'15'
  2381.     BL    KRHTC16
  2382.     N     R6,=X'000000FC' FORCE TO MULTIPLE OF 4
  2383.     CVD   R6,PWORK
  2384.     ZAP   PCOL,PWORK
  2385.     AP    PCOL,=P'1'
  2386.     LA    R6,4(R6)        ADD 4
  2387.     AP    PCOL,=P'4'
  2388.     CH    R6,=H'79'
  2389.     BNH   KRHTEXIT
  2390. KRHTC0   EQU   *
  2391.     SR    R6,R6
  2392.     ZAP   PCOL,=P'1'
  2393.     B     KRHTEXIT
  2394. KRHTC10  EQU   *
  2395.     LA    R6,10-1
  2396.     ZAP   PCOL,=P'10'
  2397.     B     KRHTEXIT
  2398. KRHTC16  EQU   *
  2399.     LA    R6,16-1
  2400.     ZAP   PCOL,=P'16'
  2401. KRHTEXIT EQU   *
  2402.     BAL   R14,SETCUR
  2403.     L     R14,KRSV14
  2404.     BR    R14
  2405. KRHTAUTO EQU   *          TOGGLE AUTO TAB MODE
  2406.     XI    HTMODE,TRUE
  2407.     BR    R14
  2408. KRCTLK   EQU   *          ROUTE TO CTL-K B,C,D,K,Q,Y
  2409.     ST    R14,KRSV14
  2410.     BAL   R14,GETKEY
  2411.     L     R14,KRSV14
  2412.     OI    KEY,X'40'  MAKE CTL A-Z = A-Z
  2413.     CLI   KEY,X'42'
  2414.     BE    KRF5       CTL-K B  F5 MARK BLOCK BEGIN
  2415.     CLI   KEY,X'43'
  2416.     BE    KRF6       CTL-K C  F6 DUPLICATE BLOCK
  2417.     CLI   KEY,X'44'
  2418.     BE    KRESC      CTL-K D  ESCAPE
  2419.     CLI   KEY,X'4B'
  2420.     BE    KRF5       CTL-K K  F5 MARK BLOCK END
  2421.     CLI   KEY,X'51'
  2422.     BE    KRBREAK    CTL-K Q  CONTROL BREAK
  2423.     CLI   KEY,X'59'
  2424.     BE    KRCTLKY    CTL-K Y  DELETE BLOCK
  2425.     BR    R14
  2426. KRCTLQ   EQU   *          ROUTE TO CTL-Q A,C,D,F,I,R,S
  2427.     ST    R14,KRSV14
  2428.     BAL   R14,GETKEY
  2429.     L     R14,KRSV14
  2430.     OI    KEY,X'40'  MAKE CTL A-Z = A-Z
  2431.     CLI   KEY,X'41'
  2432.     BE    KRF7       CTL-Q A  F7 SEARCH/REPLACE
  2433.     CLI   KEY,X'43'
  2434.     BE    KREND      CTL-Q C  END
  2435.     CLI   KEY,X'44'
  2436.     BE    KRF4       CTL-Q D  END OF LINE
  2437.     CLI   KEY,X'46'
  2438.     BE    KRF7       CTL-Q F  F7 SEARCH/REPLACE
  2439.     CLI   KEY,X'49'
  2440.     BE    KRHTAUTO   CTL-Q I  AUTO TAB
  2441.     CLI   KEY,X'52'
  2442.     BE    KRHOME     CTL-Q R  HOME
  2443.     CLI   KEY,X'53'
  2444.     BE    KRF3       CTL-Q S  START OF LINE
  2445.     BR    R14
  2446. KRBREAK  EQU   *          CTL-K Q  BREAK
  2447.     SVC   EXIT
  2448.     TITLE 'CHKMARK - IF IN MARK MODE, PRINT IN REVERSE VIDEO'
  2449. CHKMARK  EQU   *
  2450.     CLI   BLKLABEL,MARK
  2451.     BNER  R14
  2452.     ST    R14,CHKMSV14
  2453.     CLI   KEY,ASCUP     IS CURRENT KEY UP
  2454.     BNE   CHKMARK1
  2455.     MVI   BLKLABEL,FALSE  TURN OFF MARKING ON UP ARROW
  2456. CHKMARK1 EQU   *
  2457.     SR    R3,R3
  2458.     BAL   R14,PUTLINE
  2459.     MVI   BLKLABEL,MARK  RESET MARKING
  2460.     L     R14,CHKMSV14
  2461.     BR    R14
  2462.     TITLE 'UPDATE - UPDATE SCREEN LINES IN EXTENDED STORAGE'
  2463. UPDATE   EQU   *
  2464.     ST    R14,UPDTSV14
  2465.     CLI   SCRMOD,TRUE   HAS SCREEN BEEN MODIFIED
  2466.     BNER  R14           NO, EXIT NOW
  2467.     MVI   FILEMOD,TRUE  SET FILE MODIFY SWITCH
  2468.     MVI   SCRMOD,FALSE  RESET SCREEN MODIFY SWITCH
  2469.     LR    R2,R7         SAVE R7
  2470.     L     R7,ASCB
  2471.     USING SCB,R7
  2472. UPDTLOOP EQU   *
  2473.     CLI   SCBMOD,TRUE
  2474.     BNE   UPDTNEXT
  2475.     L     R12,SCBADDR
  2476.     BAL   R14,CHKADDR
  2477.     USING LB,R12
  2478.     MVC   LBLINE(L'SCBLINE),SCBLINE
  2479. UPDTNEXT EQU   *
  2480.     LA    R7,LSCB(R7)
  2481.     CL    R7,LASTSCB
  2482.     BNH   UPDTLOOP
  2483.     LR    R7,R2         RESTORE R7
  2484.     BAL   R14,AUDITMS
  2485.     L     R14,UPDTSV14
  2486.     BR    R14
  2487.     TITLE 'CHKADDR - VALIDATE SCB ADDRESS BEFORE WRITE'
  2488. CHKADDR  EQU   *
  2489.     CL    R12,MINMEM
  2490.     BL    E05
  2491.     CL    R12,MAXMEM
  2492.     BNL   E05
  2493.     BR    R14
  2494.     TITLE 'GETNEWLB - ALLOCATE NEW LB SPACE IN EXT. MEMORY IF AVAIL.'
  2495. GETNEWLB EQU   *
  2496.     L     R1,GFQEL      IS THERE ROOM FOR LB LEFT IN PRIMARY AREA
  2497.     SH    R1,=AL2(LLB)
  2498.     BM    CHKFREE       NO, GO CHECK FREE QUEUE
  2499.     ST    R1,GFQEL      UDATE LENGTH OF PRIMARY AREA
  2500.     L     R1,GFQEA
  2501.     ST    R1,ANEWLB     SET ADDRESS OF ALLOCATED LB
  2502.     LA    R1,LLB(R1)
  2503.     ST    R1,GFQEA      UPDATE ADDRESS
  2504.     B     GETMEXIT
  2505. CHKFREE  EQU   *
  2506.     L     R1,AFREELB    IS THERE AN LB ON FREE QUEUE
  2507.     LTR   R1,R1
  2508.     BZ    GETMERR       NO, EXIT WITH ERROR
  2509.     ST    R1,ANEWLB     SET ADDRESS OF ALLOCATED LB
  2510.     LR    R12,R1
  2511.     MVC   AFREELB,LBNEXT  UPDATE NEXT FREE LB
  2512. GETMEXIT EQU   *
  2513.     SR    R15,R15
  2514.     BR    R14
  2515. GETMERR  EQU   *
  2516.     ST    R14,GETMSV14
  2517.     LA    R1,=CL20'** OUT OF MEMORY **'
  2518.     BAL   R14,PUTMSG
  2519.     LA    R15,4
  2520.     L     R14,GETMSV14
  2521.     BR    R14
  2522.     TITLE 'ERROR MESSAGES'
  2523. E01      EQU   *
  2524.     LA    R2,=C'E01 - I/O ERROR ON INPUT FILE$'
  2525. ERR      EQU   *
  2526.     SVC   WTO
  2527.     SVC   TRACE
  2528.     DC    C'ERR '
  2529.     SVC   TRACE
  2530.     DC    C'BUG '
  2531.     SVC   EXIT
  2532. E02      EQU   *
  2533.     LA    R2,=C'E02 - MS-DOS EXTENDED MEMORY ALLOCATION ERROR$'
  2534.     B     ERR
  2535. E03      EQU   *
  2536.     LA    R2,=C'E03 - NO MEMORY AVAILABLE FOR ADDITIONAL RECORD$'
  2537.     LA    R15,3
  2538.     BR    R14
  2539. E04      EQU   *
  2540. EOFUT2   EQU   *
  2541.     LA    R2,=C'E04 - EOF ON KEYBOARD SIMULATOR FILE$'
  2542.     B     ERR
  2543. E05      EQU   *
  2544.     LA    R2,=C'E05 - INVALID EXTENDED MEMORY ADDRESS$'
  2545.     B     ERR
  2546.     TITLE 'DATA SECTION'
  2547.     LTORG
  2548. *
  2549. * REGISTER USAGE
  2550. *
  2551. R0       EQU   0  WORK
  2552. R1       EQU   1  WORK
  2553. R2       EQU   2  WORK
  2554. R3       EQU   3  WORK
  2555. R4       EQU   4  WORK
  2556. R5       EQU   5  ROW IN 3RD BYTE
  2557. R6       EQU   6  COL IN 4TH BYTE
  2558. R7       EQU   7  BASE FOR SCREEN CONTROL BLOCK SCB
  2559. R8       EQU   8  FIRST  BASE
  2560. R9       EQU   9  SECOND BASE
  2561. R10      EQU   10 THIRD  BASE
  2562. R11      EQU   11 LENGTH FOR CROSS MEMORY MOVE
  2563. R12      EQU   12 BASE FOR LB IN EXTENDED STORAGE
  2564. R13      EQU   13 SAVE AREA
  2565. R14      EQU   14 LINK FROM MAINLINE TO ROUTINES
  2566. R15      EQU   15 RETURN CODE FROM ROUTINES
  2567. *
  2568. * PC/370 SVC'S
  2569. *
  2570. EXIT     EQU   0
  2571. OPEN     EQU   1
  2572. CLOSE    EQU   2
  2573. GET      EQU   5
  2574. PUT      EQU   6
  2575. DELETE   EQU   7
  2576. SEARCH   EQU   8
  2577. TRACE    EQU   9
  2578. GETMAIN  EQU   10
  2579. FREEMAIN EQU   11
  2580. ASCEBC   EQU   12
  2581. EBCASC   EQU   13
  2582. RENAME   EQU   23
  2583. PRINTTXT EQU   24     MICRO-CODE PRINTING OF TEXT ON ROW VIA PC/370
  2584. VIDEO    EQU   128+16 BIOS VIDEO-IO (TECH. REF. A-48)
  2585. KEYBOARD EQU   128+22 BIOS KEYBOARD (TECH. REF. A-26)
  2586. WRITECHR EQU   200+2  MS-DOS SVC 2 DISPLAY CHAR IN R2 ON CONSOLE
  2587. READKEY  EQU   200+7  MS-DOS SVC 7 GET KEY WITHOUT ECHO
  2588. WTO      EQU   200+9  MS-DOS SVC 9 PRINT STRING WITH ENDING $ ON CON.
  2589. *
  2590. * DATA AREAS
  2591. *
  2592. ASCBS    EQU   X'08'   ASCII BACKSPACE
  2593. ASCLF    EQU   X'0A'   ASCII LINE FEED
  2594. ASCCR    EQU   X'0D'   ASCII CARRIAGE RETURN
  2595. ASCASK   EQU   X'2A'   ASCII ASTERISK FOR ALC COMMENT CHECK
  2596. ASCBLK   EQU   X'20'   ASCII SPACE
  2597. ASCTAB   EQU   X'09'   ASCII TAB
  2598. ASCRIGHT EQU   X'1C'   ASCII CURSOR RIGHT
  2599. ASCF1    EQU   X'BB'   EXTENDED ASCII F1 WITH HIGH BIT ON
  2600. ASCF2    EQU   X'BC'   EXTENDED ASCII F2 WITH HIGH BIT ON
  2601. ASCALTF1 EQU   X'E8'   EXTENDED ASCII ALT-F1 WITH HIGH BIT ON
  2602. ASCALTF2 EQU   X'E9'   EXTENDED ASCII ALT-F2 WITH HIGH BIT ON
  2603. ASCUP    EQU   X'C8'   EXTENDED ASCII UP ARROW WITH HIGH BIT ON
  2604. ASCDOWN  EQU   X'D0'   EXTENDED ASCII DOWN ARROW WITH HIGH BIT
  2605. ASCLEFT  EQU   X'CB'   EXTENDED ASCII LEFT ARROW
  2606. ASCRGHT  EQU   X'CD'   EXTENDED ASCII RIGHT ARROW
  2607. ESCAPE   EQU   X'1B'   ASCII ESCAPE KEY
  2608.     DC    C'**** KEY ****'
  2609. KEY      DC    X'00'   KEY FROM KEYBOARD OR EMULATOR FILE
  2610.     DC    C'*** LAST KEY ***'
  2611. LASTKEY  DC    X'00'   PREV KEY FROM KEYBOARD
  2612.     DC    C'**** WAITLOOP *****'
  2613. WAITLOOP DC    F'1'    DEFAULT WAIT LOOP IS 1
  2614. PWORD    DC    PL8'0'
  2615. WORD     DC    CL15' ' WORD READ VIA GET WORD
  2616. LWORD    DC    X'00'   LENGTH OF WORD READ-1 OR X'FF' IF ZERO
  2617. KEYWORD  DC    CL15' ' SEARCH KEY WORD
  2618. LKEYWORD DC    X'00'   SAVE LENGTH OF KEYWORD - 1 FOR F8
  2619. REPWORD  DC    CL15' ' REPLACE WORD
  2620. LREPWORD DC    X'00'   SAVE LENGTH OF REPLACE - 1 FOR F8
  2621. SAVETEXT DC    CL80' ' SAVE TEXT FOLLOWING KEY FOR REPLACE
  2622. FINDKEY  DC    XL256'00' TRT TABLE FOR FIRST CHAR. IN KEYWORD
  2623. FINDTAB  DC    256X'00'  TRT TABLE TO FIND TABS OR EOR
  2624.     ORG   FINDTAB+ASCLF
  2625.     DC    AL1(ASCLF)
  2626.     ORG   FINDTAB+ASCTAB
  2627.     DC    AL1(ASCTAB)
  2628.     ORG   FINDTAB+256
  2629. NUMERIC  DC    48X'FF',10X'00',198X'FF' TRT ASCII NUMERIC TEST
  2630. HEX      DC    C'0123456789ABCDEF'   CONVERT NIBBLE TO EBCDIC
  2631. HEXTAB   DC    128X'FF'              CONVERT ASCII  TO NIBBLE
  2632.     ORG   HEXTAB+X'30'
  2633.     DC    AL1(0,1,2,3,4,5,6,7,8,9)  ASCII 0-9
  2634.     ORG   HEXTAB+X'41'
  2635.     DC    AL1(10,11,12,13,14,15)    ASCII A-F
  2636.     ORG   HEXTAB+X'61'
  2637.     DC    AL1(10,11,12,13,14,15)    ASCII A-F
  2638.     ORG   HEXTAB+128
  2639. *
  2640. *  KEY ROUTINE ADDRESS TABLE
  2641. *
  2642. KRTAB    DS    0F
  2643.     DC    A(0)    ZERO FUNCTION CODE NOT USED
  2644. KEYUND   DC    A(KRUND)   KEY UNDEFINED
  2645. KEYCHAR  DC    A(KRCHAR)  PROCESS CHARACTER UPDATE ON SCREEN
  2646. KEYESC   DC    A(KRESC)   ESCAPE KEY
  2647. KEYPGDN  DC    A(KRPGDN)  PAGE DOWN
  2648. KEYPGUP  DC    A(KRPGUP)  PAGE UP
  2649. KEYUP    DC    A(KRUP)    CURSOR UP
  2650. KEYLEFT  DC    A(KRLEFT)  CURSOR LEFT
  2651. KEYRIGHT DC    A(KRRIGHT) CURSOR RIGHT
  2652. KEYDOWN  DC    A(KRDOWN)  CURSOR DOWN
  2653. KEYINS   DC    A(KRINS)   INSERT
  2654. KEYDEL   DC    A(KRDEL)   DELETE
  2655. KEYCR    DC    A(KRCR)    CARRIAGE RETURN
  2656. KEYBS    DC    A(KRBS)    BACK SPACE
  2657. KEYHT    DC    A(KRHT)    HORIZONTAL TAB
  2658. KEYHOME  DC    A(KRHOME)  HOME (TOP OF FILE)
  2659. KEYEND   DC    A(KREND)   END  (END OF FILE)
  2660. KEYALTF1 DC    A(KRALTF1) ENTER PAUSE UNTIL KEY HIT FOR EMULATOR
  2661. KEYALTF2 DC    A(KRALTF2) ENTER WAIT FOR 1 SECOND FOR EMULATOR
  2662. KEYALTF3 DC    A(KRALTF3) ENTER DEBUG MODE
  2663. KEYALTF4 DC    A(KRALTF4) TOGGLE AUDIT MODE
  2664. KEYALTF5 DC    A(KRALTF5) GO TO LINE #
  2665. KEYALTFA DC    A(KRALTF10) TOGGLE CONNECT BOX GRAPHIC MODE
  2666. KEYF1    DC    A(KRF1)    F1 HELP SCREEN 1
  2667. KEYF2    DC    A(KRF2)    F2 HELP SCREEN 2
  2668. KEYF3    DC    A(KRF3)    F3 START OF LINE
  2669. KEYF4    DC    A(KRF4)    F4 END OF LINE
  2670. KEYF5    DC    A(KRF5)    F5 LABEL BLOCK
  2671. KEYF6    DC    A(KRF6)    F6 DUPLICATE BLOCK
  2672. KEYF7    DC    A(KRF7)    F7 SEARCH
  2673. KEYF8    DC    A(KRF8)    F8 REPEAT LAST F7 SEARCH
  2674. KEYF9    DC    A(KRF9)    F9 SELECT COLOR
  2675. KEYF10   DC    A(KRF10)   F10 BOX GRAPHICS
  2676. KEYSHF1  DC    A(KRSHF1)  SHIFT F1 QUICK SAVE
  2677. KEYSHF3  EQU   KEYF3      SHFT-F3 START OF LINE
  2678. KEYSHF4  EQU   KEYF4      SHFT-F4 END OF LINE
  2679. KEYSHF6  DC    A(KRSHF6)  SHIFT F6 DELETE LINE
  2680. KEYSHF7  DC    A(KRHTAUTO) SHIFT F7 AUTO TAB
  2681. KEYSHF9  DC    A(KRHTAUTO) SHIFT F9 AUTO TAB
  2682. KEYSHF10 DC    A(KRSHF10) SHIFT F10 (CHANGE BOX GRAPHIC CHAR SET)
  2683. KEYCTLC  EQU   KEYPGDN    CTL-C PAGE DOWN
  2684. KEYCTLD  EQU   KEYRIGHT   CTL-D CURSOR RIGHT
  2685. KEYCTLE  EQU   KEYUP      CTL-E CURSOR UP
  2686. KEYCTLG  EQU   KEYDEL     CTL-G DELETE
  2687. KEYCTLH  EQU   KEYBS      CTL-H BACKSPACE
  2688. KEYCTLI  EQU   KEYHT      CTL-I TAB
  2689. KEYCTLK  DC    A(KRCTLK)  CTL-K ROUTE TO B,C,D,K,Q,Y
  2690. KEYCTLL  EQU   KEYF8      CTL-L REPEAT SEARCH
  2691. KEYCTLN  EQU   KEYCR      CTL-N CARRIAGE RETURN OR ENTER
  2692. KEYCTLQ  DC    A(KRCTLQ)  CTL-Q ROUTE TO A,C,D,F,I,R,S
  2693. KEYCTLR  EQU   KEYPGUP    CTL-R PAGE UP
  2694. KEYCTLS  EQU   KEYLEFT    CTL-S CURSOR LEFT
  2695. KEYCTLU  EQU   KEYINS     CTL-U INSERT
  2696. KEYCTLX  EQU   KEYDOWN    CTL-X CURSOR DOWN
  2697. KEYCTLY  EQU   KEYSHF6    CTL-Y DELETE LINE
  2698. *
  2699. *  KEY ROUTINE TRANSLATE TABLE WITH INDEX TO KRTAB
  2700. *
  2701. KEYTAB   DC    32AL1(KEYUND-KRTAB)  DEFAULT UNDEFINED   0-31
  2702.     DC    96AL1(KEYCHAR-KRTAB) DEFAULT CHAR       32-127
  2703.     DC    128AL1(KEYUND-KRTAB) DEFAULT UNDEFINED 128-255
  2704. *
  2705. *  OVERLAY DEFAULT INDEX VALUES WITH SPECIFIC KEY ROUTINE INDEXES
  2706. *  (SEE MASIC MANUAL APPENDIX G-7 FOR OFFSETS)
  2707. *
  2708.     ORG   KEYTAB+X'03'
  2709.     DC    AL1(KEYCTLC-KRTAB)   CTL-C PAGE DOWN
  2710.     DC    AL1(KEYCTLD-KRTAB)   CTL-D CURSOR RIGHT
  2711.     DC    AL1(KEYCTLE-KRTAB)   CTL-E CURSOR UP
  2712.     ORG   KEYTAB+X'07'
  2713.     DC    AL1(KEYCTLG-KRTAB)   CTL-G DELETE
  2714.     DC    AL1(KEYBS-KRTAB)     CTL-H BACK SPACE
  2715.     DC    AL1(KEYHT-KRTAB)     CTL-I HORIZONTAL TAB
  2716.     ORG   KEYTAB+X'0B'
  2717.     DC    AL1(KEYCTLK-KRTAB)   CTL-K ROUTE B,C,D,K,Q,Y
  2718.     DC    AL1(KEYCTLL-KRTAB)   CTL-L REPEAT LAST SEARCH
  2719.     DC    AL1(KEYCR-KRTAB)     CARRIAGE RETURN (ENTER)
  2720.     DC    AL1(KEYCTLN-KRTAB)   CTL-N INSERT LINE
  2721.     ORG   KEYTAB+X'11'
  2722.     DC    AL1(KEYCTLQ-KRTAB)   CTL-Q ROUTE A,C,D,F,I,R,S
  2723.     DC    AL1(KEYCTLR-KRTAB)   CTL-R PAGE UP
  2724.     DC    AL1(KEYCTLS-KRTAB)   CTL-S CURSOR LEFT
  2725.     ORG   KEYTAB+X'15'
  2726.     DC    AL1(KEYCTLU-KRTAB)   CTL-U INSERT
  2727.     ORG   KEYTAB+X'18'
  2728.     DC    AL1(KEYCTLX-KRTAB)   CTL-X DOWN
  2729.     DC    AL1(KEYCTLY-KRTAB)   CTL-Y DELETE LINE
  2730.     ORG   KEYTAB+X'1B'
  2731.     DC    AL1(KEYESC-KRTAB)    ESCAPE KEY
  2732.     ORG   KEYTAB+128+59
  2733.     DC    AL1(KEYF1-KRTAB)     F1 HELP SCREEN 1
  2734.     DC    AL1(KEYF2-KRTAB)     F2 HELP SCREEN 2
  2735.     DC    AL1(KEYF3-KRTAB)     F3 START OF LINE
  2736.     DC    AL1(KEYF4-KRTAB)     F4 END OF LINE
  2737.     DC    AL1(KEYF5-KRTAB)     F5 LABEL BLOCK OF LINES
  2738.     DC    AL1(KEYF6-KRTAB)     F6 DUPLICATE BLOCK OF LINES
  2739.     DC    AL1(KEYF7-KRTAB)     F7 SEARCH
  2740.     DC    AL1(KEYF8-KRTAB)     F8 REPEAT SEARCH
  2741.     DC    AL1(KEYF9-KRTAB)     F9 COLOR SELECTION
  2742.     DC    AL1(KEYF10-KRTAB)    F10 DISPLAY FREE MEMORY
  2743.     ORG   KEYTAB+128+71
  2744.     DC    AL1(KEYHOME-KRTAB)   HOME
  2745.     ORG   KEYTAB+128+72
  2746.     DC    AL1(KEYUP-KRTAB)     CURSOR UP
  2747.     ORG   KEYTAB+128+73
  2748.     DC    AL1(KEYPGUP-KRTAB)   PAGE UP
  2749.     ORG   KEYTAB+128+75
  2750.     DC    AL1(KEYLEFT-KRTAB)   CURSOR LEFT
  2751.     ORG   KEYTAB+128+77
  2752.     DC    AL1(KEYRIGHT-KRTAB)  CURSOR RIGHT
  2753.     ORG   KEYTAB+128+79
  2754.     DC    AL1(KEYEND-KRTAB)    END
  2755.     ORG   KEYTAB+128+80
  2756.     DC    AL1(KEYDOWN-KRTAB)   CURSOR DOWN
  2757.     ORG   KEYTAB+128+81
  2758.     DC    AL1(KEYPGDN-KRTAB)   PAGE DOWN
  2759.     ORG   KEYTAB+128+82
  2760.     DC    AL1(KEYINS-KRTAB)    INSERT
  2761.     ORG   KEYTAB+128+83
  2762.     DC    AL1(KEYDEL-KRTAB)    DELETE
  2763.     ORG   KEYTAB+128+84
  2764.     DC    AL1(KEYSHF1-KRTAB)   SHFT-F1 QUICK SAVE
  2765.     ORG   KEYTAB+128+86
  2766.     DC    AL1(KEYSHF3-KRTAB)   SHFT-F3 START OF LINE
  2767.     ORG   KEYTAB+128+87
  2768.     DC    AL1(KEYSHF4-KRTAB)   SHFT-F4 END OF LINE
  2769.     ORG   KEYTAB+128+89
  2770.     DC    AL1(KEYSHF6-KRTAB)   SHFT-F6 DELETE LINE
  2771.     ORG   KEYTAB+128+90
  2772.     DC    AL1(KEYSHF7-KRTAB)   SHFT-F7 SET AUTO TAB (INDENT)
  2773.     ORG   KEYTAB+128+92
  2774.     DC    AL1(KEYSHF9-KRTAB)   SHFT-F9 SET AUTO TAB (INDENT)
  2775.     ORG   KEYTAB+128+93
  2776.     DC    AL1(KEYSHF10-KRTAB)  SHFT-F10 CHANGE BOX GRAPHIC SET
  2777.     ORG   KEYTAB+128+104
  2778.     DC    AL1(KEYALTF1-KRTAB)  ALT-F1   PAUSE UNTIL KEY HIT
  2779.     ORG   KEYTAB+128+105
  2780.     DC    AL1(KEYALTF2-KRTAB)  ALT-F2   WAIT ONE SECOND
  2781.     ORG   KEYTAB+128+106
  2782.     DC    AL1(KEYALTF3-KRTAB)  ALT-F3   ENTER DEBUG MODE
  2783.     ORG   KEYTAB+128+107
  2784.     DC    AL1(KEYALTF4-KRTAB)  ALT-F4   TOGGLE AUDIT MODE
  2785.     ORG   KEYTAB+128+108
  2786.     DC    AL1(KEYALTF5-KRTAB)  ALT-F5   GO TO LINE #
  2787.     ORG   KEYTAB+128+113
  2788.     DC    AL1(KEYALTFA-KRTAB)  ALT-F10  TOGGLE BOX CONNECT MODE
  2789. *
  2790. *  END OF KEYTAB
  2791. *
  2792.     ORG   KEYTAB+256
  2793. ATTRIB   DC    X'17'        WHITE ON BLUE DEFAULT SCREEN
  2794. ATTSAVE  DC    X'00'        SAVE DURING REVERSE VIDEO MARKING
  2795. * SEE TECH. HANDBOOK 1-140 FOR COLOR ATTIRBUTES ON IBM COLOR MONITOR
  2796. * USE X'0E' FOR TURBO PASCAL DEFAULT YELLOW ON BLACK
  2797. SAVEAREA DC    9D'0'
  2798. INITSV14 DC    A(0)    SAVE LINK FOR INIT
  2799. HELPSV14 DC    A(0)    SAVE LINK FOR HELPSCRN
  2800. TERMSV14 DC    A(0)    SAVE LINK FOR TERMKS
  2801. LOADSV14 DC    A(0)    SAVE LINK FOR LOADFILE
  2802. EDITSV14 DC    A(0)    SAVE LINK FOR EDITFILE
  2803. SAVESV14 DC    A(0)    SAVE LINK FOR SAVEFILE
  2804. DISPSV14 DC    A(0)    SAVE LINK FOR DISPLAY
  2805. SETCSV14 DC    A(0)    SAVE LINK FOR SETCUR
  2806. CLRSV14  DC    A(0)    SAVE LINK FOR CLEAR
  2807. CLRLSV14 DC    A(0)    SAVE LINK FOR CLRLINE
  2808. GETKSV14 DC    A(0)    SAVE LINK FOR GETKEY
  2809. PUTLSV14 DC    A(0)    SAVE LINK FOR PUTLINE
  2810. PUTSSV14 DC    A(0)    SAVE LINK FOR PUTSTAT
  2811. CHKMSV14 DC    A(0)    SAVE LINK FOR CHKMARK
  2812. NEWFSV14 DC    A(0)    SAVE LINK FOR NEWFILE
  2813. UPDTSV14 DC    A(0)    SAVE LINK FOR UPDATE
  2814. SCRLSV14 DC    A(0)    SAVE LINK FOR SCRLDOWN, SCRLUP
  2815. KRCRSV14 DC    A(0)    SAVE LINK FOR KRCR
  2816. INSCSV14 DC    A(0)    SAVE LINK FOR KRINSCOM
  2817. KEYSSV14 DC    A(0)    SAVE LINK FOR KEYSTATS
  2818. PPCTSV14 DC    A(0)    SAVE LINK FOR PUTPCT
  2819. KR10SV14 DC    A(0)    SAVE LINK FOR KRF10
  2820. KRBXSV14 DC    A(0)    SAVE LINK FOR KRCHKBOX
  2821. SCHRSV14 DC    A(0)    SAVE LINK FOR KRSETCHR
  2822. GETWSV14 DC    A(0)    SAVE LINK FOR GETWORD
  2823. GETMSV14 DC    A(0)    SAVE LINK FOR GETNEWLB
  2824. KRWTSV14 DC    A(0)    SAVE LINK FOR KRALTF1/F2
  2825. KRSV14   DC    A(0)    COMMON SAVE FOR FIRST LEVEL KR ROUTINES
  2826. SAVER0R3 DS    4F      SAVE AREA FOR AUDIT ROUTINES (REQ'D FOR SEARCH)
  2827. KRF9SV12 DS    2F      SAVE AREA FOR F9
  2828. GETWSV34 DS    2F      SAVE AREA FOR GETWORD ACROSS GETKEY
  2829. TRUE     EQU   1
  2830. FALSE    EQU   0
  2831. MARK     EQU   2       MARKING BLK LABEL MODE
  2832.     DC    C'*** AUDIT ***'
  2833. ALC      DC    AL1(TRUE)   FILE TYPE ALC (USED FOR TAB PROCESSING)
  2834. AUDIT    DC    AL1(FALSE)  AUDIT SWITCH FOR AUDITSCB AND AUDITMS
  2835. HTMODE   DC    AL1(FALSE)  AUTO TAB MODE
  2836. EOF1     DC    AL1(FALSE)  END OF FILE
  2837. EOJ      DC    AL1(FALSE)  END OF JOB
  2838. FILEMOD  DC    AL1(FALSE)  FILE MODIFIED
  2839. SCRMOD   DC    AL1(FALSE)  SCREEN MODIFIED
  2840. BLKLABEL DC    AL1(FALSE)  LABELED BLOCK  (TRI-STATE FALSE,MARK,TRUE)
  2841. SAVBLKLB DC    AL1(FALSE)  SAVE LABELD BLK MODE DURING DISPLAY
  2842. CURDEL   DC    AL1(FALSE)  CURRENT LB DELETED
  2843. FIRSTSAV DC    AL1(TRUE)   FIRST SAVE REQUEST
  2844. REPLACE  DC    AL1(FALSE)  SEARCH AND REPLACE
  2845. GLOBAL   DC    AL1(FALSE)  GLOBAL REPLACE
  2846. BOX      DC    AL1(FALSE)  BOX CHARACTER GRPAHICS MODE
  2847. CONNECT  DC    AL1(FALSE)  BOX GRAPHIC CONNECT MODE
  2848. DIRUP    EQU   0
  2849. DIRRIGHT EQU   1
  2850. DIRDOWN  EQU   2
  2851. DIRLEFT  EQU   3
  2852. DIRLAST  DC    AL1(DIRRIGHT)
  2853. DIRNEW   DC    AL1(DIRRIGHT)
  2854. DIRTAB   DC    AL1(BU,BUR,BD,BUL,BRU,BR,BUL,BL)
  2855.     DC    AL1(BU,BLU,BD,BRU,BLU,BR,BUR,BL)
  2856. BU       EQU   0 UP
  2857. BD       EQU   1 DOWN
  2858. BUR      EQU   2 UPPER LEFT
  2859. BUL      EQU   3 UPPER RIGHT
  2860. BRU      EQU   4 LOWER RIGHT
  2861. BR       EQU   5 RIGHT
  2862. BL       EQU   6 LEFT
  2863. BLU      EQU   7 LOWER LEFT
  2864. REVDIR   DC    AL1(DIRDOWN,DIRLEFT,DIRUP,DIRRIGHT)  REVERSE OF DIRECTION
  2865. REVLAST  DC    AL1(0)                               SAVE REV OF DIRLAST
  2866. BOXSET   EQU   *
  2867. BOXSET2  DC    AL1(186,186,201,187,188,205,205,200)  GRAPHIC DOUBLE LINE BOX
  2868. BOXSET1  DC    AL1(179,179,218,191,217,196,196,192)  GRAPHIC SINGLE LINE BOX
  2869.     DC    8AL1(ASCASK)                          ASCII * PRINTABLE BOX
  2870.     DC    AL1(94,118,88,88,88,62,60,88)         ARROWS (SORT OF)
  2871.     DC    8AL1(ASCBLK)                          BLANK (FOR BG COLORS)
  2872. BOXSETE  EQU   *
  2873. BOXSETA  DC    A(BOXSET)   ADDRESS OF CURRENT BOX SET
  2874. BOXCON   EQU   *           TABLE TO CONNECT SINGLE/DOUBLE BOX LINES
  2875. *
  2876. * SEE IBM TECH. REF. FOR PC PAGES C-7 THRU C-9 FOR GRAPHICS 179-218
  2877. *
  2878. *                  ---- SINGLE --- ---- DOUBLE ---
  2879. *                   UP  RT  DN  LF  UP  RT  DN  LF
  2880. *
  2881.     DC    AL1(179,195,179,180,186,198,186,181) 179
  2882.     DC    AL1(180,197,180,180,180,180,180,181) 180
  2883.     DC    AL1(181,181,181,180,181,216,181,181) 181
  2884.     DC    AL1(182,215,182,182,182,182,182,185) 182
  2885.     DC    AL1(183,210,191,183,182,183,183,187) 183
  2886.     DC    AL1(181,184,184,191,184,209,187,184) 184
  2887.     DC    AL1(185,185,185,182,185,206,185,185) 185
  2888.     DC    AL1(179,199,179,182,186,204,186,185) 186
  2889.     DC    AL1(187,187,184,183,185,203,187,187) 187
  2890.     DC    AL1(190,188,188,189,188,202,185,188) 188
  2891.     DC    AL1(217,208,189,189,189,189,182,188) 189
  2892.     DC    AL1(190,190,181,217,188,207,190,190) 190
  2893.     DC    AL1(180,194,191,191,191,191,183,184) 191
  2894.     DC    AL1(192,192,195,193,211,212,192,192) 192
  2895.     DC    AL1(193,193,197,193,208,193,193,193) 193
  2896.     DC    AL1(197,194,194,194,194,194,210,194) 194
  2897.     DC    AL1(195,195,195,197,195,198,195,195) 195
  2898.     DC    AL1(193,196,194,196,208,205,210,205) 196
  2899.     DC    AL1(197,197,197,197,197,197,197,197) 197
  2900.     DC    AL1(198,195,198,198,198,198,198,216) 198
  2901.     DC    AL1(199,199,199,215,199,204,199,199) 199
  2902.     DC    AL1(212,211,200,200,200,200,204,202) 200
  2903.     DC    AL1(201,214,213,201,204,201,201,203) 201
  2904.     DC    AL1(207,202,202,202,202,202,206,202) 202
  2905.     DC    AL1(203,203,209,203,206,203,203,203) 203
  2906.     DC    AL1(204,199,204,204,204,204,204,206) 204
  2907.     DC    AL1(207,196,209,196,202,205,203,205) 205
  2908.     DC    AL1(206,206,206,206,206,206,206,206) 206
  2909.     DC    AL1(207,207,216,207,202,207,207,207) 207
  2910.     DC    AL1(193,208,208,208,208,208,215,208) 208
  2911.     DC    AL1(216,209,209,209,209,209,203,209) 209
  2912.     DC    AL1(210,210,194,210,215,210,210,210) 210
  2913.     DC    AL1(192,211,211,208,211,200,209,211) 211
  2914.     DC    AL1(212,192,198,212,200,212,212,207) 212
  2915.     DC    AL1(198,218,213,213,213,213,201,209) 213
  2916.     DC    AL1(214,214,218,210,209,201,214,214) 214
  2917.     DC    AL1(215,215,215,215,215,215,215,215) 215
  2918.     DC    AL1(216,216,216,216,216,216,216,216) 216
  2919.     DC    AL1(217,193,180,217,189,217,217,190) 217
  2920.     DC    AL1(195,218,218,194,218,213,214,218) 218
  2921. SCRLEND  EQU   23*256+79   SCROLL ENDING ROW AND COL
  2922. SAVETYPE DC    CL3' '      SAVE ORIG. FILE TYPE
  2923. ROWINC   EQU   256         INCREMENT FOR ROW IN R5 REG. (3RD BYTE)
  2924. MAXROW   DC    A(23*ROWINC)   LAST ROW ON SCREEN
  2925. MAXSCB   DC    A(0)           LAST ROW SCB POINTER
  2926. LASTROW  DC    A(0)        LAST ROW CURSOR
  2927. LASTSCB  DC    A(0)        LAST SCB ADDR
  2928. SAVEROW  DC    A(0)        TEMP SAVE FOR ROW (R5)
  2929. SAVECOL  DC    A(0)        TEMP SAVE FOR COL (R6)
  2930. SAVESCB  DC    A(0)        TEMP SAVE FOR SCB (R7)
  2931. BLK1LB   DC    A(0)        STARTING LB OF BLOCK
  2932. BLK2LB   DC    A(0)        ENDING   LB OF BLOCK
  2933. NEXTBLK  DC    A(0)        NEXT LB TO DUPLICATE
  2934. SAVENEXT DC    A(0)        SAVE NEXT LB FROM CURRENT LB
  2935. PREVDUP  DC    A(0)        PREVIOUS LB IN DUPLICATE CHAIN
  2936. PTOTAL   DC    PL3'0'
  2937. LOADMSG  DC    C' LINES LOADED ='
  2938. DTOTAL   DC    CL6' ZZZZZ',C'$'
  2939. LBUFF1   EQU   8192
  2940. LBUFF2   EQU   4096
  2941. LBUFFS   EQU   LBUFF1+LBUFF2
  2942. TBUFF    EQU   X'80'       COMMAND LINE IN LOW MEMORY
  2943. ATYPE1   DC    A(DSN1+4)   DEFAULT ADDR OF .XXX IN DSN
  2944. DSN1     DC    C'TEST.ALC',64X'00'  DSN FROM COMMAND
  2945. REN1     DC    C'TEST.BKP',64X'00'  RENAME DSN FOR SAVE
  2946. SYSUT1   DS    0D          DCB FOR ASCII TEXT FILE READ/WRITE
  2947.     DC    C'ADCB'
  2948.     DC    A(DSN1) ADDRESS OF UP TO 64 BYTE PATH/FILE
  2949.     DC    X'FFFF' HANDLE ASSIGNED BY MS-DOS AT OPEN
  2950.     DC    X'00'   DATA CONTROL BLOCK FLAGS
  2951.     DC    C'S'    DATA SET ORGANIZATION
  2952.     DC    C'G'    DATA SET ACCESS MODE
  2953.     DC    C'T'    DATA SET RECORD FORMAT
  2954.     DC    X'0A'   END OF RECORD CODE
  2955.     DC    X'1A'   END OF FILE CODE
  2956.     DC    H'135'  RECORD LENGTH
  2957.     DC    AL2(LBUFF1) BLOCK  LENGTH (2<BLKSZ<64K-16)
  2958.     DC    A(EOFUT1)  END OF DATA EXIT ADDRESS
  2959.     DC    A(E01)     SYCHRONOUS ERROR EXIT ADDRESS
  2960.     DC    A(WLBLINE) RECORD AREA ADDRESS FOR GET/PUT
  2961.     DC    A(0)       BLOCK  AREA ADDRESS (0 FOR DYNAM)
  2962.     DC    A(0)       RELATIVE BYTE ADDRESS
  2963.     DC    A(REN1)    RENAME ASCIIZ FILE
  2964.     DC    F'0'       BLOCK I/O COUNT SINCE OPEN
  2965.     DC    H'0'       PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  2966. *
  2967. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  2968. *
  2969.     DC    XL4'00' SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  2970.     DC    XL4'00' SEGMENT:OFFSET OF EODAD EXIT
  2971.     DC    XL4'00' SEGMENT:OFFSET OF SYNAD EXIT
  2972.     DC    XL4'00' SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  2973.     DC    XL4'00' SEGMENT:OFFSET OF RENAME FILE NAME
  2974.     DC    XL4'00' SEGMENT:OFFSET OF BLOCK AREA
  2975.     DC    XL4'00' SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  2976.     DC    XL2'00' OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  2977.     DC    XL2'00' OFFSET OF END OF ALLOCATED BLOCK AREA
  2978.     DC    H'0'    REVERSED LRECL
  2979.     DC    H'0'    REVERSED BLKSZ
  2980. *
  2981. * DATA FOR KEYBOARD SIMULATOR
  2982. *
  2983. KSOFF    EQU   0
  2984. KSREAD   EQU   1
  2985. KSWRITE  EQU   2
  2986.     DC    C'**** KSREC ****'
  2987. KSREC    DC    XL256'00'
  2988. KSRECEND EQU   *
  2989.     DC    C'**** KSNEXT ****'
  2990. KSNEXT   DC    A(KSRECEND)  ASSUME READ AND SET TO FORCE NEXT READ
  2991. KSMODE   DC    AL1(KSOFF)
  2992. DSN2     DC    C'TEST.KSF',64X'00'  DSN FROM COMMAND LINE
  2993. SYSUT2   DS    0D      DCB FOR KEYBOARD SIMULATOR
  2994.     DC    C'ADCB'
  2995.     DC    A(DSN2) ADDRESS OF UP TO 64 BYTE PATH/FILE
  2996.     DC    X'FFFF' HANDLE ASSIGNED BY MS-DOS AT OPEN
  2997.     DC    X'00'   DATA CONTROL BLOCK FLAGS
  2998.     DC    C'S'    DATA SET ORGANIZATION
  2999.     DC    C'G'    DATA SET ACCESS MODE
  3000.     DC    C'F'    DATA SET RECORD FORMAT
  3001.     DC    X'0A'   END OF RECORD CODE
  3002.     DC    X'1A'   END OF FILE CODE
  3003.     DC    H'256'  RECORD LENGTH
  3004.     DC    AL2(LBUFF2) BLOCK  LENGTH (2<BLKSZ<64K-16)
  3005.     DC    A(EOFUT2)  END OF DATA EXIT ADDRESS
  3006.     DC    A(E01)     SYCHRONOUS ERROR EXIT ADDRESS
  3007.     DC    A(KSREC)   RECORD AREA ADDRESS FOR GET/PUT
  3008.     DC    A(0)       BLOCK  AREA ADDRESS (0 FOR DYNAM)
  3009.     DC    A(0)       RELATIVE BYTE ADDRESS
  3010.     DC    A(0)       RENAME ASCIIZ FILE
  3011.     DC    F'0'       BLOCK I/O COUNT SINCE OPEN
  3012.     DC    H'0'       PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  3013. *
  3014. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  3015. *
  3016.     DC    XL4'00' SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  3017.     DC    XL4'00' SEGMENT:OFFSET OF EODAD EXIT
  3018.     DC    XL4'00' SEGMENT:OFFSET OF SYNAD EXIT
  3019.     DC    XL4'00' SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  3020.     DC    XL4'00' SEGMENT:OFFSET OF RENAME FILE NAME
  3021.     DC    XL4'00' SEGMENT:OFFSET OF BLOCK AREA
  3022.     DC    XL4'00' SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  3023.     DC    XL2'00' OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  3024.     DC    XL2'00' OFFSET OF END OF ALLOCATED BLOCK AREA
  3025.     DC    H'0'    REVERSED LRECL
  3026.     DC    H'0'    REVERSED BLKSZ
  3027. *
  3028. *  DATA FOR LINE BLOCKS
  3029. *
  3030.     DC    C'*** FIRST/LAST/CUR ***'
  3031. GLBFIRST DC    A(0) GLOBAL POINTER TO FIRST LB
  3032. GLBLAST  DC    A(0) GLOBAL POINTER TO LAST  LB
  3033. GLBCUR   DC    A(0) GLOBAL POINTER TO CURRENT LB
  3034.     DC    C'*** GFQEA/L ***'
  3035. GFQEA    DC    A(0) ADDRESS OF REMAINING FREE EXTENDED MEMORY
  3036. GFQEL    DC    F'0' LENGTH OF REMAINING FREE EXTENDED MEMORY
  3037. MINMEM   DC    A(0) LOW LIMIT
  3038. MAXMEM   DC    A(0) MAX LIMIT
  3039. ANEWLB   DC    A(0) LB ALLOCATED BY GETNEWLB
  3040. AFREELB  DC    A(0) QUEUE OF FREE LB'S CREATED BY DELETE
  3041. WLBADDR  DS    A
  3042. WLB      DS    0X
  3043. WLBPREV  DC    A(0)
  3044. WLBNEXT  DC    A(0)
  3045. WLBLINE  DC    CL80' ',CL80' ' PAD FOR EXPANDING TABS AND PRINT FILES
  3046.     DC    AL1(ASCCR,ASCLF)
  3047. TLBADDR  DS    A
  3048. TLB      DS    0X
  3049. TLBPREV  DS    A
  3050. TLBNEXT  DS    A
  3051. TLBLINE  DS    CL80,CL53
  3052. STATRC0  EQU   24*256
  3053. STATROW  DC    A(STATRC0)
  3054. STATLINE DS    0CL80
  3055. STATMSG  DC    CL20'LOADING FILE ',C' '
  3056. STATNAME DC    CL15' ',C' LINE'
  3057. STATREC  DC    CL6' ',C'  COL'
  3058. STATCOL  DC    CL4' ',C'  '
  3059. STATCAP  DC    CL3' ',C' '  CAPS KEY ON/OFF
  3060. STATINS  DC    CL3' ',C' '  INSERT MODE ON/OFF
  3061. STATNUM  DC    CL3' ',C' '  NUM KEY ON/OFF
  3062. STATBLK  DC    CL3' ',C' '  LABELED BLOCK ON/OFF (F5, CTL-K B/K)
  3063. STATPCT  DC    CL4' ',C'%'
  3064.     DC    (STATLINE+80-*)C' '
  3065.     DC    X'00'  EOR FOR PRINTTXT
  3066. KBCAP    DC    X'00'  CAPS KEY STATUS VIA BIOS KEYBOARD
  3067. KBINS    DC    X'00'  INS  KEY STATUS VIA BIOS KEYBOARD (SEE NOTES)
  3068. KBNUM    DC    X'00'  NUM  KEY STATUS VIA BIOS KEYBOARD
  3069. KBCAPLST DC    X'00'
  3070. KBINSLST DC    X'00'
  3071. KBNUMLST DC    X'00'
  3072. INSSTATE EQU   X'80' INSERT KEY ON (TECH. A-3)
  3073. CAPSTATE EQU   X'40' CAPS   KEY ON
  3074. NUMSTATE EQU   X'20' NUM    KEY ON
  3075. PBLKCNT  DC    PL3'0' RECORDS IN BLOCK
  3076. PCURBLK1 DC    PL3'0' RECORD # OF FIRST BLOCK RECORD
  3077. PCUR     DC    PL3'1' CURRENT RECORD # FOR ROW 0
  3078. PCURLINE DC    PL3'1' CURRENT RECORD # FOR CURSOR ROW
  3079. PCURSRCH DC    PL3'0' CURRENT RECORD # FOR SEARCH
  3080. PLSTLINE DC    PL3'0' LAST RECORD #
  3081. PCHKLINE DC    PL3'0' AUDIT LAST RECORD #
  3082. PCOL     DC    PL2'0' CURRENT COL
  3083. PCURLAST DC    PL3'0' LAST REC UPDATE BY SETCUR
  3084. PCOLLAST DC    PL2'0' LAST COL UPDATE BY SETCUR
  3085. FMAXLINE DC    F'0'   MAXIMUM LINES POSSIBLE IN MS
  3086. PWORK    DC    D'0'   PACKED DECIMAL WORK AREA
  3087. PWORK1   DC    D'0'
  3088.     DC    C'*** ASCB ***'
  3089. ASCB     DC    A(0) ADDRESS OF SCREEN CONTROL BLOCK
  3090. F1SC     EQU   *
  3091.     DC    CL80'SEE Screen Editor and Emulator R2.2 01/03/88'
  3092.     DC    CL80' '
  3093.     DC    CL80'Copyright (c) 1987 Donald S. Higgins'
  3094.     DC    CL80' '
  3095.     DC    CL80'Type F1 for this screen; F2 for keystroke help.'
  3096.     DC    CL80'For additional documentation, SEE PC370.DOC.'
  3097.     DC    CL80' '
  3098.     DC    CL80'SEE is a full screen color text editor distributed'
  3099.     DC    CL80'in source and object form with the PC/370 freeware'
  3100.     DC    CL80'370 cross assembler, linkage editor, and emulator'
  3101.     DC    CL80'package.  You are encouraged to copy and share'
  3102.     DC    CL80'this program provided this copyright message is'
  3103.     DC    CL80'not removed or modified and no fee is charged.'
  3104.     DC    CL80'If you find PC/370 of value, support continued'
  3105.     DC    CL80'freeware updates by registering as PC/370 user.'
  3106.     DC    CL80' '
  3107.     DC    CL80'         Don Higgins'
  3108.     DC    CL80'         6365 - 32 Avenue North'
  3109.     DC    CL80'         St. Petersburg, Florida 33710'
  3110. F1SCEND  EQU    *
  3111. F2SC     EQU   *
  3112. *                   0        1         2         3         4
  3113. *                   1        0         0         0         0
  3114.     DC    CL40'KEY     ALTERNATE   DESCRIPTION         '  1
  3115.     DC    CL40'KEY     ALTERNATE   DESCRIPTION         '
  3116.     DC    CL80' '                                         2
  3117.     DC    CL40'Esc     ctl-K D     save file and exit  '  3
  3118.     DC    CL40'PgUp    ctl-R       page up half        '
  3119.     DC    CL40'PgDn    ctl-C       page down half      '  4
  3120.     DC    CL40'arrows  ctl-S/D/E/X move cursor         '
  3121.     DC    CL40'home    ctl-Q R     go to top of file   '  5
  3122.     DC    CL40'End     ctl-Q C     go to end of file   '
  3123.     DC    CL40'Ins     ctl-U       set/reset insert    '  6
  3124.     DC    CL40'Del     ctl-G/K Y   delete char/block   '
  3125.     DC    CL40'Tab     ctl-I       tab to next column  '  7
  3126.     DC    CL40'Bs      ctl-H       backspace           '
  3127.     DC    CL40'Enter   ctl-N       next/insert line    '  8
  3128.     DC    CL40'F1/F2               help screen 1/2     '
  3129.     DC    CL40'F3/F4   ctl-Q S/D   start/end line      '  9
  3130.     DC    CL40'F5/F6   ctl-K B/K/C label/dup. block    '
  3131.     DC    CL40'F7      ctl-Q F/A   search/replace str. ' 10
  3132.     DC    CL40'F8      ctl-L       repeat search/repl. '
  3133.     DC    CL40'F9                  set color           ' 11
  3134.     DC    CL40'F10                 set/reset box graph '
  3135.     DC    CL40'Shft-F1             quick save file     ' 12
  3136.     DC    CL40'Shft-F6 ctl-Y       delete line         '
  3137.     DC    CL40'Shft-F9 ctl-Q I     set/reset auto tab  ' 13
  3138.     DC    CL40'Shft-F10            change box graph set'
  3139.     DC    CL40'Ctl-brk ctl-K Q     force exit no save  ' 14
  3140.     DC    CL40'Alt-F1              pause until key hit '
  3141.     DC    CL40'Alt-F2              wait for 1 second   ' 15
  3142.     DC    CL40'Alt-F3              enter debug mode    '
  3143.     DC    CL40'Alt-F4              toggle audit mode   ' 16
  3144.     DC    CL40'Alt-F5              go to line #        '
  3145.     DC    CL40'Alt-F10             toggle box connect  ' 17
  3146.     DC    CL40' '
  3147.     DC    CL80' '
  3148.     DC    CL80'Note F9 color selection is changed by entering'
  3149.     DC    CL80'hex digits or using arrows to select digit and'
  3150.     DC    CL80'change colors.  Press enter to continue.'
  3151.     DC    CL80'Note F10, shift-F10, and alt-F10 control box'
  3152.     DC    CL80'graphic mode, characters, and connect options.'
  3153. F2SCEND EQU    *
  3154. *
  3155. * DSECTS
  3156. *
  3157. *
  3158. *  LINE BLOCK FOR STORING TEXT IN EXTENDED MEMORY
  3159. *
  3160. LB       DSECT
  3161. LBPREV   DS    A      ADDRESS OF PREVIOUS LB
  3162. LBNEXT   DS    A      ADDRESS OF NEXT LB
  3163. LBLINE   DS    CL80   TEXT
  3164. LLB      EQU   *-LB
  3165. *
  3166. *  SCREEN CONTROL BLOCK
  3167. *
  3168. SCB      DSECT
  3169. SCBADDR  DS    A      ADDRESS OF LB IN EXTENDED STORAGE
  3170. SCBLB    DS    0XL(LLB)   LB WITHIN SCB
  3171. SCBPREV  DS    A      ADDRESS OF PREV LB
  3172. SCBNEXT  DS    A      ADDRESS OF NEXT LB
  3173. SCBLINE  DS    CL80   LINE OF TEXT
  3174.     DS    XL2    PAD FOR CR,NL FOR FULL LINE OF TEXT
  3175. SCBCOL   DS    X      COL CONTAINING CR/LF (END OF TEXT + 1)
  3176. SCBMOD   DS    X      SET TRUE IF MODIFIED
  3177. LSCB     EQU   *-SCB
  3178. ****************************************************************************
  3179. *
  3180. * IHADCB - I HAD A DCB DSECT FOR PC/370 RELEASE 2.0+ FILE DATA CONTROL BLOCK
  3181. *
  3182. * FOR MORE INFORMATION SEE SVC.DOC AND DEMO PROGRAM TESTIO.ALC.
  3183. *
  3184. ****************************************************************************
  3185. IHADCB   DSECT
  3186. DCBDCB   DS    CL4 CONSTANT EBCDIC C'ADCB' DCB IDENTIFIER
  3187. DCBDSN   DS    A   ADDRESS OF UP TO 64 BYTE PATH/FILE SPEC FOLLOWED BY ZERO
  3188. DCBFID   DS    H   FILE HANDLE ASSIGNED BY MS-DOS AT OPEN (X'FFFF'DEFAULT)
  3189. DCBFLG   DS    X   DATA CONTROL BLOCK FLAGS (ONLY DFTRAN MAY BE SET BY USER)
  3190. DFOPEN   EQU   X'80' FILE OPEN
  3191. DFUBUF   EQU   X'40' USER DEFINED BLOCK AREA (NO DYNAMIC ALLOC/DEALLOC)
  3192. DFOUT    EQU   X'20' OPEN FOR OUTPUT
  3193. DFGEOF   EQU   X'10' END OF FILE PENDING ON SHORT BLOCK
  3194. DFTRAN   EQU   X'08' TRANSLATE GET/PUT RECORDS FOR ASCII FILE
  3195. DFADCB   EQU   X'01' ASSIST DCB - DO NOT TRANSLATE 370 ADDRESSES
  3196. DSORG    DS    C   DATA SET ORGANIZATION (R=RANDOM, S=SEQUENTIAL)
  3197. MACRF    DS    C   DATA SET ACCESS MODE (R=READ, W=WRITE, G=GET, P=PUT)
  3198. RECFM    DS    C   DATA SET RECORD FORMAT (F=FIXED, V=VAR, T=TEXT)
  3199. EOR      DS    X   END OF RECORD CODE (DEFAULT IS LINE FEED X'0A')
  3200. EOF      DS    X   END OF FILE CODE   (DEFAULT IS CTL-Z X'1A')
  3201. LRECL    DS    H   RECORD LENGTH (2<LRECL<64K-16)
  3202. BLKSZ    DS    H   BLOCK  LENGTH (2<BLKSZ<64K-16)
  3203. EODAD    DS    A   END OF DATA EXIT ADDRESS
  3204. SYNAD    DS    A   SYCHRONOUS ERROR EXIT ADDRESS
  3205. RCD      DS    A   RECORD AREA ADDRESS FOR GET/PUT
  3206. BLK      DS    A   BLOCK  AREA ADDRESS (0 FOR DYNAMICALLY ALLOCATED)
  3207. RBA      DS    A   RELATIVE BYTE ADDRESS FOR RANDOM READ/WRITE
  3208. REN      DS    A   RENAME ASCIIZ FILE (ONLY USED BY RENAME SVC)
  3209. IOCNT    DS    F   BLOCK I/O COUNT SINCE OPEN
  3210. PRECL    DS    H   PHYSICAL BLOCK SIZE OF LAST READ/WRITE
  3211. *
  3212. * RESERVED AREA FOR USE BY PC/370 IOS SUPERVISOR WHILE FILE OPEN
  3213. *
  3214. DSNSG    DS    XL4 SEGMENT:OFFSET OF DCBDSN PATH/FILE NAME
  3215. EODSG    DS    XL4 SEGMENT:OFFSET OF EODAD EXIT
  3216. SYNSG    DS    XL4 SEGMENT:OFFSET OF SYNAD EXIT
  3217. RCDSG    DS    XL4 SEGMENT:OFFSET OF RECORD AREA FOR GET/PUT
  3218. RENSG    DS    XL4 SEGMENT:OFFSET OF RENAME FILE NAME
  3219. BLKSG    DS    XL4 SEGMENT:OFFSET OF BLOCK AREA
  3220. BLKPTR   DS    XL4 SEGMENT:OFFSET OF CURRENT RECORD IN BLOCK AREA
  3221. BLKEOD   DS    XL2 OFFSET OF CURRENT END OF DATA IN BLOCK AREA
  3222. BLKEND   DS    XL2 OFFSET OF END OF ALLOCATED BLOCK AREA
  3223. WLRECL   DS    H   REVERSED LRECL
  3224. WBLKSZ   DS    H   REVERSED BLKSZ
  3225. LDCB     EQU   *-IHADCB
  3226.     END   SEE
  3227.